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COMPUTER PROGRAMS FOR CALCULATING POTENTIAL 
FLOW IN PROFUSION SYSTBi INLETS 

■by 

Norbert O 0 Stockman and Susan L. Button 
INTRODUCTION 


In the course of designing inlets at the Lewis Research Center, .particularly 
for VTOL and STOL propulsion systems, a calculational procedure utilizing 
three computer programs evolved (refs. 1-3). The chief program is the Douglas 
axisymmetric potential flow program called EOD which calculates the incom- 
pressible potential flow about arbitrary axisymmetric bodies. : The other two 
programs,, original with Lewis, are called SCIRCL and ' COMBYN. Program SCIRCL 
generates input for EOD from various specified analytic shapes for the inlet 
components. Program COMBYN takes basic solutions output by EOD- and combines 
them into solutions of interest, and applies a compressibility correction. 

These programs are still in a state of development and users 1 manuals for them 
are not yet available. However, in the interests of making the programs avail 
able immediately, it was .decided to publish the current versions in the "Quick 
Release" form with a. minimum of write-up, ■ First a brief, summary of what each 
of the three programs does together with references to pertinent literature 
will be given. . This is followed by a description of the input and output of 
programs' SCIRCL and COMBYN. Next, listings of all three programs are given. 
Finally, a test case for checking-out the programs is presented. 

It should be noted that programs SCIRCL and COMBYN were originally written 
for VTOL inlets and some of the input and output parameters are VTOL oriented. 

DESCRIPTION OF PROGRAMS 


SCIRCL 

The purpose of this program is to supply accurate input to the potential flow 
program. To this end the inlet surfaces (e.g„, hub and shroud.) are divided 
into segments each of which is a portion of an analytical curve as illustrated 
in figure 1. The curves available are listed in the description of- SCIRCL 
input. SCIRCL distributes points along the inlet surfaces in such a way as to 
meet the requirements of program EOD. The coordinates of these points are 
punched on cards for direct input to EOD along with other information required 
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by EOD. In addition, SCIRCL outputs printed information about the inlet sur- 
faces (coordinates, curvature, slope, etc.). 

In addition to the surface points, sets of points spanning the passage, like 
flow measuring rakes, are needed at axial locations where velocity profiles 
or streamlines are desired , At least one "rake" must be specified for use 
as a control station . (The function of the control station is given under 
COMBYN. ) Program SCIRCL generates the coordinates of the rake points and 
punches them on cards for input to EOD. 

EOD . 

This is the Douglas incompressible potential flow computer program for axisym- 
metric bodies. Only the bodies must be axi symmetric; the flow itself need not 
be. The details of the Douglas method are covered extensively in references 
4 to 6; the highlights will be outlined herein. 

1. Bodies are represented by a distribution of sources and sinks of 
initially unknown strengths. 

2. An integral ‘ equation in the unknown source strength is derived from 
the potential ' flow equations and boundary conditions, 

3. The integral equation is appproximated by a set of linear algebraic 
equations corresponding to discrete points on the bodies . 

' 4. These equations are solved for the source strength by matrix methods. 

5, Velocities are calculated on the surface and at other points of in- 
terest (such as rake points ) in the flow field from the source distribution 
obtained in step 4. 

The program was originally written for closed bodies in a free stream. To 
apply the method to inlets, the inlets are idealized by adding artificial 
extensions to the inlet surfaces as shown in figures 2 and 3« The method of 
idealizing conventional inlets is given in reference 7 and that for lift fan 
or lift engine inlets in reference 2, 

The Douglas program is used to obtain three basic solutions for the idealized 
inlet profile and certain free-stream conditions. The basic solutions are 
ones (e.g„, as shown in fig. 4) that provide a convenient basis for generating 
the combined solutions that represent flow conditions of interest. The three 
basic solutions and the method of combining them are discussed in reference 2, 
Program EOD has been modified to output the basic solutions on punched cards 
for input to program COMBYN. No further description of EOD input or output 
will be given. 
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COMBYN 


This program combines the basic solutions from EOD into any number of solutions 
of interest,, A solution of interest or combined solution is one having speci- 
fied values of free stream velocity ' V«» and direction oC and control sta- 
tion velocity V c (as shown in fig. 5 for a VTOL inlet). As an alternative 
to V c , the inlet weight flow ft may be specified, in which case the program 
will convert w to V c . . Temperature and pressure must also be specified if 
other than standard conditions are desired. These and other COMBYN inputs are 
described later. (Note that COMBYN requires oC. p rather than c<- where 
odp = -9O0 ) 

The method of combination of the basic solutions is essentially that given in 
reference 2 and is summarized in .figure 5 . The only major difference is in. 
the compressibility correction. The current version of COMBYN uses the com- 
pressibility correction method of reference 8. This method is referred to 'in 
the COMBYN program listing as Approach 5 compressibility. 

One of the. "rakes" mentioned under SCIRCL, is used as a-control station by 
COMBYN. The control station is the rake at which the average inlet axial ve- 
locity V c of the -combined solution is specified. If there are severa.1 rakes 
any one may be used as the control station. -It should be noted, however, that- 
the solution is most accurate in the vicinity of the control station. The 
inaccuracies, which often.- are not significant, ; arise from the method of calcu- 
lating the basic solution for inlets and from the compressibility correction 
which does not exactly satisfy continuity. 
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Flow splitter programming not complete through COMBYNo (Flow splitters extend far downstream, acous 
tic splitters do not 0 ) 
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1 < ENREED < 10, superellipse with exponent equal. to 
ENREED. Input coordinates • 1,2,4, 5. Read in 0.0 for point 
no. 3„ (Point no. 3 is not used, "but points 4 and 5 must 
be in the proper columns.) (fig. 7(t)) 
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A and B = semi-major- and minor axis of the transformed superellipse 0 
XO and YO = Center of the transformed superellipse 

OMEGA = The difference between the slopes (in radians) of the superellipse end points 
• minus ,T/2 o 0. . 


+ 
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XRAK - Axial location, of the rake 

YLO - Y value of first location on rake (either read in value or computed value) 
YKE - Y value of last point on the rake (either read in value or computed value) 
NDY - Number of Y points calculated for XRAK. 



XON - axial location 

YON - Y value on the shroud 
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associated with the boundary layer, displacement thickness 
If YC = 0„0 the program will interpret this as a code and 
will calculate VC from WDOT. (To run a case with VC 
actually equal to zero set WDOT = 0.0.) 
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The number of the last point on the hub (this. can be found 
in the printed output of SCIRCL) 0 
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LISTINGS OF PROGRAMS 
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of“>ooonr>ooooooonr>o m f> o o o o r> o rv 


* i 


SC IRC L 


* IBFTC SCIRCL 

PREPARE INF.LT DATA FCR DOUGLAS POTENTIAL FLOW PROGRAMS EOD AND 22Y 

SECCNC VERSION - SPACING SPECIFIEC 

DIMENSION SC ( 500 ) * SI500), N V { 2 5 > 

COMMON / S LPF / IFLC 

COUPON /FAIN/ 'XIN(IO) , YI N ( 10 ) , DELS MX , P IC2 , CEL S 1 , IHUB 
CCMMCN /<S/ NBCY1 ,NBCCY2,TYPPDY,NBCYS 

COMMON /MnR TE/ t F L AG , NDY4 , PRCG , T I T LE ( 9 ) , BOC l F.S ( 4 ) , I C ENT , YLO ( 25 ) , YH 
H (25 ) ,NDY (25) ,XRAK(25> ,NBDPT$C5) ,NC6, NRAKES 
CCMMCN /FCR3SS/ I ,OELS,XBK <2C ) , YRK (20 ) , XCN ( 5C0 ) » YON ( -5 00 ) , DYDXO( 5-"\) 
1 ) , AL PHA ( 5 CC ) »C APP A ( 5CQ ) » SON ( 500 ) » P 10180 
COMMON /SPREP/ KPREP 
COMMON / M N S 0 / NNSC , NS DB DY ( 10 ) 

CCMMCN /NHIGH/ N S PHG , NL A ST , X L AS T ( 500 ) , YL A S T ( 500 ) 

Pl=»2.14159265 
P IC l'EO=P I / 1 80 • 

P I C 2 f P I / 2 • 

WHEN NOfc = 1, A FLAG IN CARD COLUMN 6 IS PUNCHED FDR 50D 
ONLY RASIC DATA WILL RE GIVEN IN 50C PROGRAM 7 

REAC <5,E4) TITLE 
RE AC ( 5 » E 2 ) IDENT ,PRCG,N06 
WRI1E (6,54) IDENT 

REAC INPIT CARDS FOR SUPERCIRCLF 

1 — CASE HEADER CARD — NO. OF BOGIES, CASE NO. , CEL S , DEL SM X 
GFF-BOCY 

2 — NRAKES = NUMBER OF RAKES (TOTAL NUMRER CANNOT EXCEED 25) 

2 — X » YLO , YH I , NY (DATA FOR EACH RAKE) 

X = X OF THE RAKE. 

YLC = Y CF THE FIRST PT. ON RAKE CLOSEST TO THE HUB - SHOULD BE 
ABOUT DS GREATER THAN Y ON HUP 

YH I = Y CF THE LAST PT ON RAKE CLOSEST TO THE SHROUD - SHOULD PE 
ABOUT DS LESS THAN Y ON SHROUC 
NY = NC. OF PTS TO GENERATE FOR THAT RAKF 

CN-eCDY 

FOR EACH SEGMENT A DESCRIPTION CARD IS NEEDED, 

THIS CARO CENCTES THE TYPE OF LINE, AND THE 
CGCRC INATES OF THE LINE (UP TD 5 SETS) 

REAC (5, ICC) ANPCYS,CELS,DELSMX,XRI,ANNSC 
REAC ( 5, EC > NRAKES , 

REAC ( 5 » 1C4 ) . (XRAKU ) ,YLC( I ) ,YHI ( I ) ,NY( I ) , 1 = 1, NRAKES ) 

DERLC ( XRA K ( I ) , YLC ( I ) , YH I ( I ) , NDY (11,1=1, NRAKES) 

WRITE (6,76) ANBCYS,CELS,DELSMX,XR l 
DC 4 1=1, NRAKES. 

4 NC Y ( I ) -NY ( I ) — 1 


< 2 / 



<“>00 oo<*><*>ooof“vn< a > n nn <*»or>fSor> 


4 




NL A S 1=C 
NSPH G=C 
CELS 2 =OEl S 
DEL S l=DEl S 
N8CY'S=ANEDY S 

NN SC = ANNS 0 o 

K = COUNTER FOR THE NUMBER OF ONBODY POINTS GENERATED 

IHte = C, WHEN THERE IS ONLY ONE ROOY — IF THERE IS ONE RODY 

IT MST B E THE SHROUC 

IFLAG = C, IF THERE IS MORE THAN ONE BODY 
K = C 

I H U P = 0 
IFl AC=C 

v 

N 2 t COP IS FOR THE NUMBER OF BODIES 

DC 26 NZ=1 fNPDYS 
IF (NZ.GE.2) I HU E = 1 

TYFECY = 1 FOR HUB TYPRCY = 2 FCR SHROUD 

OR 

TYPECY = 1 FCR HUB * TY PRO Y = 2 FOR FLOW SPLITTER * TYPPCY=3 FOR SHROU 
^**#*FLCv SPLITTER PROGRAMMING IS NOT COMPLETE THROUGH COM RYN* * * ** 
*****FLCV SPLITTER IS NOT THE SAME AS NCISE SUPPRESSION DEVICES 
(N.S.C.) SPLITTERS***** 

OR 

IF THE HIB IS TO BE MIRRORED , SET TYPBDY FOR THE SHROUD = 0.0 

READ ( 5 » 1 C 6 ) TYPPDY » ANSEG 
NSEG=ANSEG 

IF (NBDYS .EG.2.AND.NZ.EQ.2.AND.TYPPDY.NE.O.O ) TYpRDY=3.0 
IF (NBDYS. EC. 1. AND. TYPBDY. EQ. 2.0) IFLAf,= l 
IF (TYPRCY. EC. 1. ) WRITE (6,120) 

IF ( TYPBC Y.EC.3.C.0R.TYPBDY. EQ.O.O.OR.NRCyS.EC. 1 ) WRITE (6,122) 

IF (TYPRCY. EC. U.C) GC TO 24 

IF (TYPBCY.EQ.2.C.ANC.NPCYS.GT.1) WRITE 16,124) 

K = M1 

SON (K 1 =C.C 
SEGMENT ICCP 
DC 22 J = I » N S E G 

READ (5, ICE) ENREED, (XIN( I ) ,YIN( I ) ,1 = 1,5) 

K S V = K 

CAPPA(K)=C.C 

IF (ENREED.NE.l.C.AN'C.ENRECD.NE.10. ) GC TO 10 
XCN ( K ) =X I N ( 1 ) 5 

YCN (K)sYlN(l) 

V/R IT E (6,112) ENREFD, (XIN( I ) ,1=1 ,2 ) , ( YIN( I ) , 1 = 1,2) 

DEBLGXON (K) ,YON(K ) , T Y PRO Y , K , ENRE AC , NS EG , J , ( X I N ( I » , Y I N ( I, ) , 1= 1 , 5 ) 

IF ( TYPBC Y.GE.2.0 ) GC TO 8 

IF (ENREEC.EC.l.C.ANC. J.EC.NSEG) CALL FNSTRH (K) 

IF (ENREEC.EC.l.C.ANC. J.NEiNSEG) CALL STRAIT (K,C.O) 

IF (ENREEC.EQ.1C. ) CALL FRSTSH { K ) 

- 2.<3 . 0 

\J) i 


0 



6 DVCXC(KS\ ) =0YDXCMKSV+1) 

ALPHA?(KS\ l=ALPHA (kSV+1) 

GC TC 22 

8 >IF (J.EC.l) CALL FRSTSH (K) 

IF (J.EG.NSEG) CALL FNSTRH C K I 

IF ( J.NE.l.ANO.J.NE.NSEG) CALL STRAIT (K,U.O) 

GC 1C 6 

1C IF ( ENRE E O.LT.-2.Q) GO TO 20 
IF (ENREED. LT. -1.0) GO TC 18 
IF ( ENRE EO.LT.O.C) GC TO 16 

« i ■ 

C SET-LP SLPER ELLIPSE 

c 

j KPREP=G 

! ENRC=ENREEC-10C0. 

IF (ENRC.LT.C.O) GO TO 12 
ENREED=EAREED-1CCC. 

IFLC=IFLC+1 
GC TC 14 
12 TFLC=0 

14 WRITE (6ill4) ENREEC, (XIN( I ) ,1 = 1 ,5 ) , (YI.M.I ), 1 = 1? 5) 
CALL TEST (5) 

. ISTART=K 
K 1 =K 

CALL SLPERC ( X IN' , Y I N , ENREED , CEL S 1 , I ST ART ) 

K= I- 1 
K2^K 
ICLP *0 

>IF ( K PREF . EG .0 ) GC TC 22 
CALL PRELPS ( IDUP,1,5,K1,K2) 

GC TC 22 
C 

C SET-LP LEKM SCATE f 

C 

16 WRITE (6,116) ENREED, ( X I N ( I ) ,1 = 1 ,3 ) , (YIM I ) , 1 = 1, 3) 
CALL LEP (K) 

K = K-«1 
GC TC 22 
C 

C SET-LP ELLIPSE 

C 

18 WRITE (6,110) ENREED, ( X I N ( I ) ,1 = 1 ,4 ) , (YIM I ) , 1 = 1 ,4) 
KPREP-G 
CALL TEST (4) 

K1 = K 

CALL ELIFSE (K) 

K = K ■< 1 
K2=K 
I C L P = 0 

IF (KPREF.EC.O) GC TC 22 
CALL PRELPS ( IDUP ,1 ,4 ,K1 ,K2 ) 

GC TC 22 
C 

C SET-LP CLBIC 

C 

2C WRITE (6,126) ENPEED , ( X I N ( I ) , 1 = 1 ,4 ) , ( Y IN ( I ) , 1 = 1 , 4 ) 


23 



CALL CUBIC <K) 

K=M1 

2 2 CONTINUE 

C 

C ENC CF SEGMENT LOOP 

C 

GC TC 26 

24 CALL MIftPCR (K.ANSEG) 

2t NBCPTS(N2)=K 

NBCY 1=NECPT S ( 1 ) 

NBCC V2=N6CP TS ( 2 ) 

28 CONTINUE 

C 

C ENC CF BCCY LOOP 

C 

iIT0P'12*K 

C 

C **N.S.O. SPLITTER SUBROUTINE 

C 

IF (NNSO.NE.C) CALL SUPRO ( K > 

IF ( IFLAG.EC.l I NBDY1 =0 
Y4SAVE*YCN {NBDY1 ) 

Y5SAVE=YCN (NRDY1+1 ) 

Y6SAVE=YCN(NBOOY2) 

Y7SAVE=YCN (NB00Y2+1 ) 

DEBUG ( XOM I ) , YON II ) , C YDXO ( I ) , ALPHA II) »C ARP A (I ) ,SON( I ) ,SON( I ) » SON ( I 
1.) » I = 1 » K } 

CS 

C 

C CO-ORDINATES OF FOINTS ON DOWNSTREAM CLOSURE 

C 

C 

C STRAIGHT SECTION BETWEEN HUB AND SHROUD CR SPLITTER 

C 

c 

sIF (NbDYI.EC.O) GC TC 30 
YNPCY1=YCN (NBDYl ) 

GO TC 32 

3C YNBCY1*0.C 

Y4SAVE=C.C 

2 2 NC Y4 = ( YCN < NBD Yl+ 1 ) -YNBDY 1 ) *1 .5/CEL SVX 
ENCY4=NCT4 
NPTS=NDY44I 

NBCPTS (NBDYS + 1 )=NPTS+NBDPTS (NRDYS) 

DY4 - ( YON I NPCYl + 1 )-YNeOYl J/ENCY4 
CC 24 I=1,NPTS 
AYEN= 1-1 

+ipn=i+:k 

XCN ( IPNMXCNINB0Y1+1) 

YOM IPN) = YN8DY1 + AYEM*0Y4 
34 CONTINUE 

ITCPT4*K4l 
ITCPT5M1CPT4 + NDY4 
IF (NBCYJ.LE.2) GC TC 38 
C 

c 

ay 



C STRAIGHT SECTION BETWEEN FLOW SPLITTER AND SHROUC 

c 
c 

YNEC Y2=Y6 SAVE 

NCY5* ( Y7«AVE-Y6SAVE)*1.5/DELSNX 

ency5=ncy5 
NP 1 5 °NDY * ♦ 1 

NBCPTS(NB0YS+2 )»NPTS*NBOPTS( NBDYS+1 1 
CY5- (Y7SAVE-Y6SAVE I VENOY5 
CC 26 1=1 »NPTS 
AYEPM-1 
'IPN= 1+JITCPT5 
XCN (1PN) 3 XCN<NRCCY2+1 1 
YCN ( IPN) 3 YNEDY2+AYEN*DY5. 

3 6 CONTINUE 

ITCP16=I1CPT5*I 
ITCPT7=I7CPT6+NOY5 
C 

c CALL SUBROUTINE TO WRITE AND PUNCH CARDS 

C 

36 CALL WPLACH 

IF (NBPYi.GT.2I GC TC 40 
NT1 3 1T0P15-2 
N T 2 3 N - 2 
GC TC 42 

4C NT 1 3 1 TOP 1 7- 5 

NT 2 3 I TOP 1 5-4 
NT 2 = K- 3 

NSPL>X=NECC Y2-2 

42 NHL PP X=NP D Y 1- 1 

NP = C 

PC 44 1 = 1 .NRAKFS 
np = np+;ncy ( i i + i 
44 CONTINUE 

NH 6i k XC =NH LG P X 
IF (NBDY5.LE.2) GC TC 46 

WRITE ,(6,110 1 NT1,NT2,NT3,NHLBMX,NSPLMX,NP 
GC TC 48 

4fc WRITE ( 6 , ICC 1 NT1,NT2,NHUBMX,NP 

C 

C CALCULATING HUB SURFACE OISTANCE (S-S(2)l 

C 

46 CALL SINTP ( XON , SON , N BO Y 1 , XR I , S 2 1 
WRITE (6,861 

IF ( IFLAG.EC.il GC TC 52 
SCEL *0.C 
DC 5 C I»1,NB0Y1 

IF (I.NE.l) SDEL = SON(I ) - 'SON ( 1-1 1 
SC( I )=SCMI 1-S2 

5C WRITE ( 6 , S 2 1 I , XCN ( I l , YON ( I 1 ,C APP A ( II , DYCXC ( I) , ALPH A ( H , SON ( l 1 , SC( 
I I ) , 5CEL 
C 

C CALCULATION SHRCLO OR LOWER FLOW SPLITTER SURFACE DISTANCE 

t ’■ ’ 

52 NE P 1 3 NBC Y 1 + 1 

IF (IFLAC.EC.l) NB0D>2=1 TOPI 2 


2b 



DC 5 4 I=?KBP1,NB0DV2 

;jj-i 

*IF (XON( n.LT.XON'd + l) ) GO TC 56 
54 COMINUE 

56 CALL S IN IP ( XON ( NBP1 ) , SON ( NBP 1 ) , J J-NPDY1 ,XR I , S22 ) 

IF ( IFLAG.EC.l) GO TC 58 

MR IT E Id.ee) 

56 IF (NBDYS.LE.2) JJ=NPODY2 

SC EL = O.C 
DC 6C I ®KB P 1 » J J 

•IF (I.NE.NBP1) SDEL = SON( I )-SCN( 1-1 ) 

S ( I ) =S22- SON ( I ) 

6C MR IT E (6,52) I ,XCN (I) , YONII ) ,C APPA ( I) , DYCXC ( I ) , ALPHA ( I ) , SON ( I ) , S ( I 
1.) . SC EL 

IF (NBDYS.LE.2) GO TC 70 

t 

C CALCULATING FLOW SPLITTER UPPER SURFACE DISTANCE 

C 

j j « j j +: i 

WRITE (6,56 ) 

CALL SIMP (XON( JJ) ,SON< JJ) , NBOOY2-J J,XR I , S23 ) 

SCEL-O.C 

DC 62 I =% J , NBODY 2 

IF (I.NE.JJ) SDEL=SCN(I J-SON(I-l) 

S ( I ) — SON (I ) - S23 

62 WRITE (6,52) I , XCN ( I ) , YON (I) ,C APPA (I) , DYCXC ( I ) , ALPHA ( I ) , SON (I) , S ( I 
I), SC EL ' 

C 

C CALCULATING SHRCLO SLRFACE OISTANCE (IF THERE IS A FLOW SPLITTER) 

C 

NBPl=NBCCY2+l 

DC 6 4 I =NB P 1 , I TO P 1 2 

JJ-I , 

’IF ( XON< I ) .LT.XCN ( 1 + 1) ) GO TC 66 
64 CONTINUE 

66 CALL SIMP ( XON (NBP 1 ) , SON ( N8P1 ) , J J-NR0DY2 , XR I , S 33 ) 

WRITE (6,56) 

SC EL =0.C 

CO 6 E I =N BP I, I TCP 12 

vIF (I.NE.NPPI) SCEL = SON( I )-SCN( I-I ) 

$ ( I ) = S 3 3— SON ( I ) 

6 6 WRITE (6,52) I , XCN ( I ) , YON ( I ) , C APPA ( I ) , DYCXC ( I ) , ALPHA ( I ) , SON ( I ) , S < I 
1),SCEL 
C 

C WRITE 0U1 N.S.D. SPLITTER POINTS 

C 

7C NBCSV=NBCYS 

IF (NNSD.EC.C) GC TO 74 
, N$ = l 

72 I E C = N B 0 Y S + N S 

INSC*I+NSCBDY(NS) 

IBNSC=I-ei 

WRITE (6,126) I BC 

WRITE (6,120 (I .XON (I) ,Y0N( I ) , C APPA ( I ) , CYCXO ( I ) , ALPH A ( I ) „S0N< I ) , I 
UIBNSD.INSC) 

N S = N S -P 1 


26 




IF (NS.LE.fvNSD) GC TC 72 
N8DYS=IBC 
C 

C WRITE CUT CLOSURE COORDINATES 

C 

74 >IBC = K»DY* + 1 

WRITE (6,90 IBD, < I ,XON< I ) ,YCN( I) , 1= IT0PT4, IT0PT5) 

IF ( KBDSWKE • 3 ) GC TC 76 
.’IRC = IBD+ 1 

WRITE <6j9C) IBOt ( I ,XON< I) ,YCN( I I , IMT0PT6, IT0PT7) 

76 WRITE ( 6 , 1C2 ) ( XR AK ( I ) , YLO( I ) , YH I (I) ,NY ( I) , I = 1 , NRAKES I 
CALL AREA A . 

GC TC 2 
C 

C FORMATS 

C 

C 

76 FORMAT ( 1HC , 10X , 16HNC . OF BODIES = , F2 .0 , 5X , 7HDELS = , F6#3» 5X, 9HDE 
ILSMX = ,F6.3,5X,6HXRI = ,F10.6) 

•8C FORMAT (2CI4) 

62 FORMAT (2A6,I4) 

84 FORMAT ( « A 6 ) 

86 FORMAT ( 1 X /1X23HECOY 1 CO-ORDINATES - X12X1 HY 10X5 HKAPPA10X5HDY /CXI 
10XEFALPHA 5X1HS8X6HS-S (2) , 8X , 6HDELT A S / 1 X ) 
ee FORM T ( 1X/1X23HB0DY 2 CC-ORCINATES - XI 2 X 1HY10X 5HK A PPA 10X5HDY /DX 1 
1CX5FALPHA5X1HS,8X,7HS • ( 2 ) -S , 8X , 6HD ELT A S/ 1 X ) 

9C FORMAT (1X/1X5HBCDY II, 1:7 H CO-ORDINATES - X12X1HY/1X / ( 9X I4,3XE12«5 

1, E 1 2 . 5 H 

92 FORMAT <5XI4,3XE12.5,7E13.5> 

94 FGPMAT (6H1CASE A6/1X) 

96 FORMAT UHC) 

58 FORMAT ( I X/1X,23HB00V 3 CO-ORDINATES - X, 12X , 1HY , 10X , 5HK APPA , 1CX , 5 
1HC Y/DX, 1C X ,5H ALPHA ,5X,1HS,8X ,6HS-S (3) , 8X ,6HDELT A S/ 1 X ) 

ICO FORMAT ( / 1 C‘ X » 3CH I NPL T FOR THE COMBINE PROGRAM, 7H NT(1) = ,I4,7H NT ( 
12 ) = » 14 ,6F NHUBMX= , 14 ,4H NP=,I4/) 

1C2 FORMAT ( 1 X ,4H XRAK , 10X ,3HYL0 , 1 1 X , 3H YH I , 16X,3HNDY//, ( 3 E 14 . 5 , 5X , I 3 )) 
1C4 FORMAT (2E6.5,I3) 

1C6 FORMAT (EF1C.2) 

1C8 FORMAT ( F 1C .2 , 1CF7. 2 » 

110 FORMAT ( / 5 X ,30H INPUT FOR THE COMBINE PROGRAM, 7H NT(1) = ,I4,7H NT(2 
1 1= , 1 4 » 7H NT(3)=,I4,8H NHUBMX = ,I4,8H NS PL MX = , 1 4 , 4H NP=,I4/I 
112 FORMAT (lHCtl0X,6HENREED,10X,13HSTRAIGHT L INE/ 1 IX , F6 . 3, 5X , 1HX , 1 P2E 
I15.4/22X,1MY,1P2E15.4) 

1 14 FORMAT ( 1HC,10X,6HENREED,10X ,12HSUPERELL IPSE/11X ,F6. 2 ,5X, 1HX,1P5E1 
15.4/22X,1HY,1P5E15.4» 

116 FORMAT ( 1HC , 1 OX , 6HENR EED , 10 X ,10H L E MN I SC ATE/ 1 1 X , Ffc.3, 5X, 1HX, 1P3E15. 
14/22X,1HY ,1P3E15.4) 

118 FORMAT (lHC,10X,6HENREE0,l0X,7HELLIPSE/HX,F6.3,5X,lHX,lP4E15.4/22 
1X» 1HY v 1PA E 1 5 • 4 ) 

120 FORMAT < 1HC ,2X,16H**** HUB *«*♦**♦**) 

122 FORMAT MFC *2X,16H**** SHROUD ******) 

124 FORMAT ( ]HC ,2X ,18H**** SPLITTER *♦**) 

126 FORMAT ( 1HC , 1 OX , 6HFNREE0 , 10X ,5HCUB IC/1 IX ,F6 ,3 , 5X , 1HX , 1P4E 15 . 4/ 2 2 X, 
1 IF Y , 1P4E 15,4) 

128 FORMAT ( 1 X / 1 X , 5HP00Y , I 2 , 17H CO-ORDINATES - X,12X,1HY,10X, 5HK APP A , 1 
10X ,5HDY/CX ,10X,5HALPHA,5X, 1HS,8X,6HS-S (2 ) , 8X , 6HDELT A S / IX ) 

130 FORMAT (5 X , 14 ,3X ,E12. 5 , 5E13. 5 ) 

BND 
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C SLeRCUTINE TO HANDLE NOISE slppressicn DEVICE SPUTTERS 

c 

SLERCUTINE SUPRO (K) 

CCPNCN /FCP3SS/ I .DELS, X8K ( 2C ) , YBK ( 20 ) , XCN ( 500 ) » YON ( 500 ) » DYDXO { 500 
1 ) » ALPHMJCC) .CAPPAI5C0) »S0NI50G> tPIOlfiO 
CCNt'GN /FAIN/ XIM 10 );, Y I N (10 I ,DELSPX ,-P IC2 , CELS 1 , IHUR 
COMMON / FiN SC/ NNSC »NSD8DY ( 10 ) 

CGP'PGN /SPREP/ KPREP 

CCPNON /NHIGH/ NSPHG,NLAST,XLAST(500),YLAST(500> 

CCKF'CN /slpf/ ifld 
IFLC fe O 

READ t 5 * S C ) DELS 
EELS 1=DEL S 
EC Id N=I,NNSO 
NSPFC=C 
K = M1 

WRITE ( 6 , 1 E ) N 
KN S C = K 

NSEC- = MRBER OF SEGMENTS ON THE SPLITTER 
NSHIGH = NSEG/2 FCR THIN SPLITTERS 

= NSEG ( FOR ALL OTHER SPLITTERS ) 

RE AC (5,22) NSEG » NSHIGH 
EC 14 J=] , NSEG 

RE AC I 5 * 5 A ) ENREED, (XIN(I),YIN(i), 1=1, 5) 

>1 F (J.GT. NSHIGH) NSPFG=1 
KS V = K 

CAPPAKKJsO.O 

IF (ENREEC.NE.1.0 ) GC TO 2 
>CN(K)=X1N (1) 

YCN(K)=YIN(1) 

NLAST=NLAST-1 

VRITE (6,26) ENREED, (XIN(I ) , 1 = 1 ,2) , (YINCI ) * 1 = 1, 2) 

CALL STRMT (K,O.C) 

DYCXCTKSV)=DYDX0(KSV+1) 

ALPHAI(KS\ ) = ALPHA (KSV+1) 

GC TC 12 

IF < ENREEC.LT. -2.0 ) GO TO 10 ' 

IF (ENREEC.LT. -1.0) GO TO 8 
IF (ENREED. LT. C.C ) GC TO 6 

SET-LP SIPERELLIPSE 

XPREP=0 

WRITE (6,28) ENREED, (XIN( I ) , 1 = 1 ,5) , ( Y IN ( I ) , 1 = 1,5) 

CALL TEST (5) 

-istart=k 

K1=K 

CALL SUPERC ( XIN ,Y IN, ENREED, CELSl , 1ST ART ) 



K=I-1 
K 2 5K 
‘ICLf'-O 

CC 4 l<L=J«l,K2 
YL A S T ! ( KL ) = YCN’t KL ) 

A XLAST IKL)=XCN(KL) 

IF l(KPREF.EC.O) GC TC 12 
CALL PRELPS ( I DUH't 1 ,5 »K1 ,K2 ) 

GC TC 12 
C 

C SET-UP LEPNISCATE 

C • 

fc WRITE (fc,3C) ENREED,(XIN( I) , 1 = 1 ,3) , ( Y!N( I ) , 1 = 1,3) 

CALL LEP ( K ) 

K = M1 
GC TC 12 
C 

C SET-LP ELLIPSE 

C 

<8 WRITE (6,32) ENRE ED , ( X I N ( I ) , 1 = 1 , A ) , ( Y I N ( I) , I = 1 , A ) 

K P P E P = C 
CALL TEST ( A ) 

K1 = K 

CALL ELIFSE (K) 

K = 1 

K2 = K 
ICLN=G 

IF (KPREF.EC.O) GC TC 12 
CALL PRELPS ( IDUP, 1,4 ,K1,K2) 

GC TC 12 
C 

SC S ET - UP CLP I C — — - — 77 

t 

1C WRITE (6,34) ENREED, (XIN( I ) , 1=1,4) , (YIN( I) , 1=1,4 ) 

CALL CUR 1C <K) 

K=M1 

12 sIF < J.EC.NSHIGH) NLAST=K 

14 CONTINUE 

C 

C NLP86R CF PTS ON EACH NSO 

NSCBCYIN )=?K-KNSO + l 
16 CONTINUE 

RETURN 
C 

C FCRPATS 

C 

C 

16 FCRPAT ( 1HC ,2X ,23H**** SPLI TTER ( NSC ) NO. ,12) 

2C FCRPAT (6F1C.2) 

2 2 FCPPAT (16 IS) 

24 FCPPAT (F1C.2.1GF7.2) 

26 FCRPAT ( 1HC ,10X,6HENPEE0»10X,13HSTRAIGHT L INE/ 11 X , F6 . 3, 5X , 1HX, 1 P2E 

115.4/22X,1HY,1P2E15.4) 

26 FCRPAT (]HC,10X,6HENREED,10X,12HSUPERELLIPSE/11X,F6.3,5X, 1HX„1P5E1 

1«.4/22X,1HY,1P5E15.4) 

3C FCRPAT ( 1HC , 10X , 6HENP6ED ,10X , 10HLEPN I SC ATE/1 IX , F6. 3 , SX, 1HX, 1P3E15. 
14/22XrlHY, 1P3E15.4) 

32 FOPPAT ( 1HC ,10X,6HENPEED,10X,7HELLIPSE/11X,F6.3, 5X, lHX,lP4E15.4/22 

l'X » lHAf *1P4E 1 5 .4 ) 

34 , FCRPAT (lHC,10X,eHENREED,10X,5HCuBIC/HX,F6.3 f 5X,lHX,lp4E15.4/22X, 
1 1HY ,1 P4E 15.4) 

ENC 
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$ IB FTC WPNCH DEBUG 


SUBROUTINE V> PUNCH 

CCFFCN /SS/ NBDY1 ,NBC DV2 ►TVPeDY ,NBCYS 

CCFFCN /FCR3SS/ I ,OELS, XBKI2C) ,YBK (20) ,XCN{5C0) , YON ( 5GO ) , DYDXO < 5C0 
U,/>LPHA('CC>.CAPPA(5CO> » SON < 500 ) ,P 10180 
GCFFCN / N b R TE / I F L AG , NO Y4 , PR CG t T I T L E < 9 ) , POC I ES ( A ) , I CENT, YLOI 25 ) , YH 
1 1(25 ),NC><25) ,XRAK(25 ),NBDPTSI5) ,NC6,NRAKES 
DIMENSION- YCFF(2CC), XOFF(20C>, FI(5C0) 

CCFFCN / N N S C / NN SC * NS CBDY 1 10 ) 

DATA B0CYC/6H-BCCY / , IFLAG1/4H 111/, IFLAC-2/4H 1 1/,T22Y/6H 22Y/, 

1IFLG2A/1F / • IFLG2B/1HI/ 

IF YLO AFC YH I ARE READ IN AS 7.FR0 , CALCULATE THEF FOR THAT RAKE 
(FCR HUB AND SHROUD CASES CMY ) 1/4/73 

FIND HIGHLIGHT ON THE SHROUD 

Nfi=NBDPT S ( 1 ) + 1 
NE=NEDPTi(2) 

CC 2 I =NE ,NE 

IF (XON( I + D.LT.XCNU )) GO TC 2 
JF I N = I 
GC TC 4 
CONTINUE 
CO 6 I = 1 , N E 
FI(I)=1 
NO F F *C 

CC 16 1= I ,NRAKES 
NLG=N0FF*1 
N'C F F =NLC -< N C Y ( I ) 

ENCY-NDY I I ) 

IF ( YHI ( I ) .EG.C.C.OR.YLOI I ) • EC* 0*0 ) GO TC 8 
GC TO 12 

e IF ( YH I ( I I.NE.C.C) GC TO 10 

CALL SINIP CXONtNB) ,YCN(NB) , JF l N-NP+ 1 , XR AK ( I ) ,YH) 

GALL SIMP ( XCN(NB) ,FI (NB) , JFIN-NB + 1 ,XRAK( I ) , FI I ) 

7F=F II 

CS = SCRTUXCM IF)-X0NIIF+1))**2+ (YCN( IF)-YON( IF+1 ))**2 ) 

YHI (I ) =YH-C S 

1C F IYLOM I.NE.C.C.OR.XRAKII) .LT.XON(l) > GO TO 12 

CALL SIMP (XCN,YCN,N8DPTS(1 ),XRAKII) ,YL ) 

CALL SIMP ( X 0 N t F I , NBDPTS(l) »XRAk( I ) , F I I ) 

IF=iFII 

DSnSCRTt IXCM IF)-X0NM IF + i ) ) **2 + (YONI IFJ-YOM IF+1 ) 1**2) 

YLC I I ) =Yl +C S 

12 CYI= (YHI1I >-YLO( m/ENDY 

CC 14 J = N L C ,N'OFF 
C J F = J — NLC 
*XCFF l J ) = >RAK 1 1 ) 

YCFF { J)=UC(I )+DYI*DJF 
14 CONTINUE 



16 CONTINUE 

NTED'r-NBC YS+NNSD+1 
ML C G I 5 =2 

I F (NBDY i . EC • 3 ) GG TC 18 
C-C TC 20 

IE NTECV=NTfDY+l 

NL CCP = 3 
20 K = C 

CG 22 1 = 1 t ML OOP 
M = N T f! D Y- 1 + 1 
IFLAGG=IFLAG2 

IF (F.EG.NTeDY.AND.NeDYS,EG.2.0R.NRDYS.EC.3.AND.«.EQ.3) I FL AGG = I FL 

1 AG 1 

>IF (PROG.EC.T22Y) GO TO 22 

WRITE <6,3A) (TITLE(L) t L=l,9),F,BcrYD, ICENT 
ViR 17 E (6,361 F,IFLAGG,N06,I0ENT 
GO TC 2A 

22 TFLG22 = IFLC-2A 

WRITE (6, AC) F,IFLG22,(TITLE(L) ,L=1,7) ,F,BCOYC, ICENT 

2 A WRITE (6,38) IDEM 

N A = 1 
NS=C 

IF (I.NE.l) K = 1 
CO 30 J=1.M 

»IF ( J.GT.NEDYS.ANO.NWSO.NE.O) GO TC 26 
NBsNBDPTS ( J) 

G C-TC. 28 _ _i 

26 NS=?NS>:i 

ilF (NS.GT.NNSD) N SOBC Y ( N S ) *N eDPT S ( NBC Y S+ 1 ) -NBCP T S ( NR DYS ) 

NB-NSOBO (NS)+:NA-i 
26 NP-NE-NAll 

CALL VIR T S Y ( N P , I DENT , J , K , XON , YON ,N A , NB , PROG ) 

NA tNR+11 
30 CONTINUE 

K = C 
NA t 1 
NEtNCFF 
J = C 

CALL VIRT > Y ( NOFF , I DEN T «. J , K , XC F F , YOF F , N A , N B , PROG ) 

•IF. (PROG.NE.T22Y) GO TO 32 
*IFLG2 2 = IFLG2B 

WRITE (6, AC) F,IFLG22 , (TITLE (L) ,L=1,7) ,N,BCDYC, ICENT 
WR 17 E ( 6 , A 2 ) 

22 CONTINUE 



r 

RETURN 


- 

v» 

C 

C 

FORMATS 



c 

r 



- 

3 A 

FORMAT 

(1H$,9A6,11,A6,2X,A6) 


36 

FORMAT 

flHI,Il»AA»Il» 56'X , A6 » 1 IX ) 


36 

FORMAT 

C 1H * ,62X,A6,11X) 


AC 

FORMAT 

(1H1 , I i,6Hll ,A1,AX,7A6, U,A6,1X,A6> 


A 2 

FORMAT 

ENC 

( 1H1 ,3HC.C ,7X,3H0.0,7X,3H90. ) 
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$ I B P 1C W R YX Y • 


•SUBROUTINE WRTXY ( NP , I DENT , J ,K , X , Y ,NA , NB , PROG ) 


WRITE X AND Y COORDINATES 


CINENSICN Mil, V ( 1 ) 

DATA T22V6F 22Y/ 

WRITE (6,E) NPfICENT 
'IF (PROG. ME .T22Y ) GO TO 4 
-IF -( J.NE.C ) GO TC 2 
WRITE (6, IE) J,K,lOENT 
GC 1C 6 

WRITE (6,14) J ,K , IDEM 
GC 1C 6 

WRITE (6,10 J,K,IDENT 
IF ( K • EG . 1 ) RETURN 
WRITE (6,12) (XU) ,L = NA,NB) 
WRITE (6,12) (YU) ,L=NA»NB) 
RETURN 

FCRNAT STATEVENTS 


FCPKAT (1WJ,7X,I3,52X,A6,11X) 

1C FCRNAT (1H$,9X,I1,9X,11,42X,A6,11X) 

12 FCRNAT (1F*,6F10.6) 

14 FCRNAT ( 1H $ ,9X,I 1 ,9X » 1H1 ,9X, 1 1 , 32X , A6 , 1 1 X ) 

16 FORNAT (lHt,9X,Il,19X,Il,32X,A6,llX) 

END 


3Z 



j-rtortrv) rtflo 


*I8F7t SIR 7 


SUBROUTINE STRAI7 <K,ISHR) 

A REGULAR S7RAIGHT SEGMENT 

JCCRfCN /f'AIN/ XIN(IO) , YI N ( 10 ) , OELSMX , P I C2 , CELS 1 , IHUP 
CCRM.GN /FCR3SS/ I ,0ELS ,XBK ( 2C ) ,YPK<20 ) ,XCN(500) ,Y0N( 500) ,DYDX0( 5C0 
1)»ALFHA(SCC ) ,CAPPA ( 5C0 ) » SON (500 ) ,P 10180 
COM MEN / S S ✓ NBDYl ,NBCDY2 ,TYPBDY»NBCYS 
GCNNCN 7FNS7/ NFIRST 

CCNNCN / N H I G H / NSPHG , NLA ST, XLAST (500 ) 

KF I P S T = K 

XTEST = XIM2)-XIN(1) 

Y7ES7=YIA(2)-YIN(1) 

•I F (XTES7 .EC.0.C ) GO TO 2 

CYCXC=Y7ES7/XTES7 

ALPFAC=A7AN(YTEST/XTEST) 

GC 7C 4 
CYCXC=9S«S5. 

ALFFAG=P1C2 

calculate celsKv* 


57C7=SQR7 ( >TEST**2+Y7EST**2) 

ANCS=STC7 /CELS1 
AINC$=AIAT (A NOS) 

?TE S7=ANCS- A INDS 

IF (7ES7.GE..5) A INDS =A I NDS+ 1 .0 
CELSNW=S1C7/AIN0S 
DELSNW = AES(CELSNVi) 

CELS l=DEl SNW 
'IF (YTES7) 6,12,6 
fc 'IF (XTEST.EC.O.C) GO TO 18 

DYCXCT K+l ) =DYDXC 
‘ALPHA (K+l > = ALPHAC 
SICN=1.C 

IF ( XTES7.LT. 0.0) SIGN=-1.0 

YCN ( K + 1)*YCN(K)-kSIGN*DELSNW*SIN( ALPHA (K+l) ) 

>IF (NSPHG • EC .0 ) GC TC 8 
XCN ( KH 1 ) * XCN ( NLAS7-1 ) 

NL A S T = NL A S 7-1 
GC TC 1C 

8 XCNTK+l J=XCN(K ) ♦ S I GN*0E L SNW*COS ( ALPHAIK+l I ) 

1C SCN(KHl) = SCMK) + SORT( ( XON ( K+ 1 ) - XGN ( K ) ) **2 + ( YON ( K + l ) - YON ( K ) ) **2 ) 

GAPPAKK+1 ) =C.O 

IF ( XTES7.LT.0.0. AND. XON (K + l I . LE .X IN ( 2 ) . CR . XTEST .GT . G .O.ANO.XON (K + 
1 1) • 0 E • X I M 2 ) ) GC TO 2 0 

■IF (A8S(>0N(K + 1)-XIN(2) ) . LE . 1 . DE-A *0 EL S. AND . ABS ( YON ( K + 1 ) -Y IN ( 2 ) >.L 
TE.1.CE-4<DELS) GC TO 20 
N=K <1 
GC TC 6 
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12 CYCXCslK-tl )=0.0 

ALPHA* K+l )=C.O 
S I G N = l • G 

IF (XTES1.LT. 0.0) SIGN=-1.0 
>IF (NSPHC.EC.O) GO TC 14 
XCN(K+1) 3 XCN(NLAST-1) 

NLA$*T = NLA ST*1 
GC TC 16 

14 XCN ( K + 1 ) 3 XC N ( K ) + S I GN*DEL SNW 

16 YCMK + 1) 3 YCN(K ) 

SON (K + l ) 3 SCN ( K J + SCRT ( (XGN(K+1 ) - X ON ( K ) ) **2 + ( YON ( K + 1 ) - YON ( K ) )**2 ) 

cafpa(k+:d=c.o 

IF (XTES1.LT.0.C.AnD.XGN(K+ 1 ).LE.X IN (2 ) .OR .XTEST.GT. u .0 . AND . XON ( K + 
11) .C-E.XIM2 )') GO TO 20 

IF ( A8S( >CN (K+1)-XIN(2) ) . LE . 1. OF-4 *D ELS. AND . ABS ( YON ( K +1 )-Y IN { 2 ) ) .L 
IE. l.CE-4*CELS ) GC TO 20 
K = K i 1 
GC TC 12 

IE CYCXC'(K+-] ) = S 9 9 *9 9 . 

ALPHA‘(M1 ) = P I 02 
SIGN=1.C 

IF (YTES1.LT. 0.0 ) SIGN=-1.0 
XCMK + 1)*>CMK) 

<YCN(K + 1 J = YCMK) + S IGN*DELSNW 

SON (K+1) 3 SCN(K)+SCRT( (X0N(K+1 )-XGN(K) ) **2 + ( YON ( K+l ) - YON ( K ) )**2) 
CAPPATK-tl )=C.O 

IF ( Y TES1.LT. 0.0. AND. YON (K+l ).LE.Y IN ( 2 > .CR .YTEST .GT.O.O. AND. YON ( K + 
11).GE.YIM2) ) GC TO 20 

IF ( A B S ( >0N (K + 1)-XIN(2) ) . LE . 1 . 0E-4*DEL S. AnC. ABS ( YON < K + 1 ) -Y I N ( 2 ) ) .L 
IE. l.CE-4*0ELS ) GO TO 20 
K«.K4'1 
GC 1C lfi 
2C K = K 1 

CO 22 KAL^KFIRST.K 
22 ALPHAHKAl ) sALPHA(KAL)/PI0180 

RETLRN 
ENC 



1 18 FTC CLB 1C. 

SLERCUT I N E CUBIC (K) 

C 

C FIT A CLEIC BETWEEN 2 STRAIGHT LINES — RESTRICTION — THE STRAIGH 

C LINES CANNOT BE VERTICAL 

C • • , 

CINENSICN AA(a,A>. BETA) 

CCRHCN /WAIN/ XI M 10 ) , Y I N ( 10 ) » OELSPX , P.IC2 . CELSl , IHUB 
CCHHCN /FCR3SS/ I , OEL S , XBK ( 20 ) , YBK ( 20 ) t XCN ( 5C0 ) ,YON( '00) tOYOXOT 500 
1 I *ALPHA(ECC ) , CAP PA (SCO) » SON ( 500 ) tP 10180 
CCPPCN ✓ ? S / NBDY I , NBC DY2 » TYP PQY , NBCYS 
CELSIN=CELS1 
CEL 5*0EL 5 1 
KCLN T =C 
K = K- 1 
KSTART=K 
X2=iX IN (21 
X3 3 X IN ( 3 ) 

Y2 3 Y IN (21 
Y3 3 Y IN ( 3 ) 

SLCP2 = (Y1MA)-Y3)/(XIN(A)-X3) 

C 

C SEUP A X A PATPIX OF COEFFICIENTS 

C ' • : ' • . • . • 

A A ( 1 , l) = ] . C 
A A 1 1 , 2 ) 3 > 2 
AA( 1,3) = >2*X2 
AA M »A ) O 2**3 
AA (2.11-C.C 
A A ( 2 » 2 ) 3 1 • C 
AA ( 2 » 3 ) 3 2 »C * X2 
AA (2,A)=2.C*X2**2 
AA(2,1)=1.C 
A A I 2 1 2 ) 3 > 3 
AA ( 3 » 3 ) = ) 2**2 
AA < 3 ,A ) = >3**3 
A A ( A » 1 ) =( . C 
AA (A ,2) = 1 .C 
AA (A ,3 )=2 .C*X3 
AA (A ,A )=2.C*X3**2 
CC 2 I 1 = ] ,A 

CEBLC(AAUI,JJ),JJ 3 1,A) 

2 CCNT1NLE 
C 

C SETLF VECTCR OF ORIGINAL CONSTANTS — BP 

C 

Beil )=Y2 

ee <2 ) =< Y2-Y 1N< 1 > >/ (X2-XINT1 ) ) 

BE (2 1 = Y 3 

EE (A J =* ( Y IN (A 1-Y3 1/ (XIN( AI-X3 ) 

DEELC (BB(I ) * I =1 » A ) 
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NSlRfc* 

K$IP*0 

CALL SIPC (AAi,BB,NSIN,KSIM) 

C = B B 1 1 1 
C=8B|2) 

A=8E(A) 

c=ee< 2 ) 

B=ee<3) 

4 K = K $ T AR T 

KC IN T»KCl M + 1 
X0M('K + 1)*XIN(2) 

YC N ( K + 1 ) = Y IN ( 2 ) 

CYCXCKK+1 )=2.C*A«XON(K+l )**2+2.G*B*XON(K+l ) +C 

CAPPA(K+])=(6.0*A*X0N<K+l) + 2.l)*B)/m.Q + CYCXn(K + l)+*2)**1.5)- 
ALPF Al( K + 1 )=ATAN(CYOXC(K+l) ) 

CS=?CE1_$/U.C-* ; .2*TANH( ABS (CAPFA(K + 1 )) ) ) 

6 K = K+!1 

CXKPl^DS/ ( SGRTd.C + OYDXC (K) ) ) 

‘IF (XlN<2 J.LT.XIM2J) 0XKP1=-DXKP1 
XCN'(K + 1) = XCN (K)+CXKP1 

YCN(K+1 ) = A* XON (K+l ) * *3+ B*XON ( K+ 1 ) * *2 +C*XCN (K + l ) +0 
DYCXCCK+II )=3.0*A*XON(K+l)**2+2.0*e*XCN(K+l )+C 
GAPPA(K+1 ) = (6.0*A*XCN (K+l ) +2.0*0 )/ ( C 1 .0 + C YDXC I K + 1 ) * * 2 ) * * 1 . 5 ) 
CSsfcElS/U.C-*;.2*TANH ( ABS (CAPPA (K+l ) > ) ) 

ALP(-Al(K+l ) = ATAN(CYOXC (K+l) ) 

SCN (K + l ) = SCN (K J + SGRT ( ( XON ( K+ 1 ) -XON ( K ) ) **2 + ( YON ( K + 1 ) - YON ( K ) )**2 ) 
IF (SLCP2 .GT.1.0 ) GO TO 8 

IF (XINC< >.GE.X3.AND.X0N(K+1 J.GT.X3) GOTO 10 

IF (XIN(O.LT.X3.AND.XON(K+1 ).LE.X3) GO TO 10 

GC TO 6 

<8 IF (YIN<< ).GE.Y3.AND.Y0N(K+1 ).GT.Y3) GOTO 10 

IF (YlN<4 ) .IT.Y3.AN0.Y0N(K+1 ).LE.Y3) GOTO 10 

GC TO 6 

1C 'I F (KOUNT.GT.ICO) GC TO 20 

DELSS^OELS 

CS1EST=( <XCN(K+1 )-XIN (3) ) **2 + ( YCN ( K+ 1 ) -Y IN ( 3 ) )**2)**.5 
IF (ABS(CS-CSTEST).LT..01*DS) GO TO 12 
IF (CSTE5T.LT. .01*DS> GO TO 14 
IF (CSTE5T- • 5*0S ) 18,16,16 
12 K=K-1 

14 XCN ( K + 1 ) = X I N ( 3 ) 

YCN (K+l)* YIN ( 3) 

GC TC 2C 

16 DEL S -DEL S+(CS-DSTEST)/FL0AT(K-1-KSTART) 

! I F (K0UN1.GE.10) DELS = (OELS+CELSS) /2.0 
GL TC 4 

IE OEl$*OELS-CSTEST/FLOAT(K-K START) 

>IF -(K0UN1.GE.1Q) CELS=(OELS+CELSS) /2.0 
GC TO 4 

2C CEL S l«iOS* 1 . 2 

■IF (CELS1 .GT .DELS ) 0ELS1=0ELS 
WRITE (6,24) KOUKT , A ,B ,C ,0 
WRITE (6,26) OELSIN,C-ELS,OELS1,OSTEST 
KENC-K+1 
KSTART = K5 TART+!1 
DC 22 I=?K ST ART ,KEND 
ALPHAS I ) * ALPHA ( I ) /PIC 180 
2 2 CONTINUE 

RETURN 


FORK AT (1HC,2X,I4,2X, 10H ITERATIONS, 2X,4HA = , IP E 12 . 5 , 2X , 4HB = , l p E 
1 12.5<,2X,<FC - ,1PE12.5,2X,4HC = ,1PE12.5) 

26 FCRPAT ( 2 X , 1CHDE L S IN = ,F8. 5 ,3X ,7HDELS = , F8 . 5 , 3X , 1 1 HOEL S OUT = , 
lF8.5f,3X,«HCSTEST = ,F8.5) 

ENC 
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! $ IBF 1C FNSF'B 

SLPRCUTINE FNSTRH (K) 

FINAL STRAIGHT SEGMENT ON THE -HUB ANC SHROUD 

CCKKON /FAIN/ X I M 10 ) . V I N ( 10 I .DELS NX , P 1 02 , C ELS 1 , I HUP 
CONCN /FCR3SS/ I .DEL S » XBK ( 2C ) , YBK ( 20 ) , XCN ( 5C0 ) , YON ( 5 00 ) , 0YDX0 ( 500 
1 ), ALPHA (fCC ) .CAPPAI5C0) ,S0N (500) ,P 10180 
CCNRCN / 5 S / NBDY1.NBC0Y2.TYPEDY.NBCYS 
CCPNON /FNST/ NFIRST 
NF I RS'T = K 
CS=0ELS1 
CELSTR=CELSHX 
YTEST=YIN(2 l-YIMl) 

XTEST=XIN (2 )-XIN (1 ) 

ASIGN*1.( 

IF (XTEST.LT. 0.0 ) AS IGN=-1 . 0 
ISTAR=0 

SS EG- SORT (XTE5T**2+YTEST**2) 

IF (XTEST.EC.0.0) GO TO 2 

-*IF— (YTESl.Ee.O.G)-GG— TQ-4 

CYCXC=YTBST/XTEST 
ALPH AC=AT AN ( YTEST /XTE ST ) 

SINAt=SIN (ALPHAC ) 

COS AL=iCCS ( ALPHAC ) 

GC TC 6 

2 CYCXC=SIGN (99999 . , YTE ST ) 

ALFHAC=SIGN (PI02, YTEST) 

SINAl=l.C 
CCSAL=C.C 
GC TC fc 

4 CYCXC=G.C 

AL PH AC=C • 0 
SINAL=C.( 

CCSAL=1.C 

fc DYCXC(M1 ) =C YDXC 

ALPHA IK*] )= ALPHAC 
IF (CS.GT .CELSHX ) GO TO 8 
GC TC lfc 

>8 <1 F (ISTAF.NE.G) GC TClfc 

DSLAST=CS 
■XCN'l K-Hl I s XCN ( K ) 

YCN(K+1)=YCN(K) 

•ICCLNT =C 

1C XSAVE=XCN (K41J-XIK (1) 

YSAVE=YON (K>1 )— YIN ( 1 ) 

SSTAR = SCPT (X SAVE **2 + Y SAVE **2 ) 

ASTAR=?(S!EG-SSTAR) /OELSTR 
ATEST=sASTAR-FLGAT( I F I X ( A STAR )) 

IF (A TEST. GT. .5) ASTAR= ASTAR+1.0 
NSTARsIFIX (ASTAR) 
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CS= (SSEG-SS TAR ) /FLOAT (NSTAR) 

IS TAR=1 

IF (CS.GT.CSLAST.CR. NSTAR. EG. 0) GC TO 12 
’IF ( ICOLNT.GT.G) K=K4l 

GC TC 16 ; 

K = K- 1 

’IF (K.GT.NF IRST) GC TO 14 
K=NF IRST 

CALL STR/IT (K,C> 

K = K- 1 
GC TC IE 

DSLAST=SCRT(( XCN (K-l )-XON<K) ) **2+ ( YON ( K-l ) -YON ( K ) )**2)*1.2 
CEL S TR=C HAST 
T C C L M = I C C L N T + 1 
GC TC 1C 

XCN (K-Fl ) = XCN (K ) + ASIGN*DS*COSAL 
YCN ( K + l ) 3 YCN(K)+ASIGN*DS*SINAL 

SON ( K + l ) 3 SCN ( K ) + SCR T ( ( XON ( K + 1 ) -XON (K ) ) **2 + ( YON { K + 1 ) -YON ( K ) )**2> 
CAPPA (K+l )=C.O 

IF (ABSOON (K + 1)-XIN(2) ) . LE . .00 1 *DS. AND. XT EST .NE .0.0 ) GO TO 18 
IF (ABS(TCMK + 1)-YIN(2) ) .LE. ,001*DS. ANC.XTEST.EQ.O.C ) GO TO 18 
K=K + 1 

IF (ISTAR.EG.O) CS=DS*1.2 
GC TC 6 
CELSl^DELS 
XCMK+:i) = XIN(2) 

YCN (K+l )= Y IN ( 2 ) 

NP C Y 1 =K+ ] 

K = M1 

CC 2C KAL=NFIRST,K 

ALPHA (KAl )= ALPHA (KAL)/PIC180 

RETLRN 

ENC 
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SUBROUTINE FRSTSH (K) 

FIRST STRAIGHT SEGMENT SHROUC 

vIF THERE IS NO HUB INTERCHANGE POINTS (XI, YD AND (X2, Y2) 
AND TREAT LIKE FINAL STRAIGHT SECTION CN THE HUB, 
THEN REVERSE XGN AND YON ARRAYS 


COMMON /H A i N / XI N i 10 ) , YI N( 10 > ,DELSMX ,P 102 , DELS1 , IHUB 
COMMON /FCR3SS/ I ,DEL S , XBK ( 2G ) , YBK < 20 ) , XCN (500) , YON ( 500 ) , DYDXO ( 500 
n, ALPHA (fCC ) ,CAPFA(5C0) ,SON( 500) ,P 10180 
COMMON / 5 S / NBDY1,NBC0Y2,TYPBDY,NB0YS 
COMMON / F N S 7 / NFIRST 

DIMENSION X A ( 2 ) , YA(2), 0SV(500), ASV(500), XSV(50G), YSV(5C0), SS 
IV (ECC) 

SCN(K)=C.C 

-IF (IHUB, EC. 1) GC TO 8 
CO 2 1=1,2 

XA ( I ) =? X I N ( I ) 

'YA(IHYIMI) 

X I N ( 1 J = X A ( 2 ) 
iXIN ( 2 ) =XA (1 ) 

YIN(1)=YA (2) 

YIM2)*YM1) 

NFE2=K 

YCN(K )=YIN ( 1 ) 

XGN ( K 1 =X IN ( 1 » 

CALI FNSTRH (K) 

KS V = K 

DO A I=NFB2,KSV 
KSP-MSV+l-I 
DSV(KSR)*DYDXO(I ) 

AS V( K SR ) * AL PH A ( I ) 

XSVHKSR»'«XCN(I» 

•YSVt(KSR)*YCN'U» 

SS V( KSR ) * SCN ( I ) 

DC 6 I =NF B 2 , KS V 
CYCXOU )’DSV( I ) 

ALPHA(I)*ASV( I ) 

XCN(n=XSV(I) 

ffQKH).*Y'V(I) 

SON ( I ) =SS V ( I ) ' 

cappai mc.o 

CONTINUE 

CELS1=ABS (SCN(KSV)-SCN(KSV-l ) ) 

NBC Y 1=0 
RETURN 

IF THERE IS A HUP, USE X VALUES FROM FINAL STRAIGHT 
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SECTION ON THE HI B FOR FIRST STRAIGHT SECTION ON 
SHF CtC 

X T E $ T = X I N ( 1 ) - X I N ( 2 ) 

YTEST=YIN ( 1 I-YIN (2 ) 

IF (XTESl.EC.O.C) GO TO 10 
DYCXC-YTEST/XTES.T 
ALPFAC=AIAN2 ( YTEST ,XTEST) 

GC TG 12 
1C CYCXC=SS«SS. 

ALPHAC=P1C2 
12 K=K-1 

NBCC-NBCY1 

IF (TYPECY.EC.3.C.ANC.N8DYS.EQ.31 NiRCC = NP0CY2 
CC IE I =N F I R ST fNBDC 
KEEP=NBDC+NFIRST-I 
XCN (K + l ) = XCN (KEEP ) 

CYCXC (K+l )=CYDXC 

ALPHA(K+1)=AlPHAC 

IF { I.EC.NFIRST) GC TC 1A 

YCN ( K + l ) » YCN ( K )+ (XON (K+l )-XCMK 1 )* CYCXC 

SON (K+l )= SCN ( K )+ (XON(K)-XCN( K+l ))*C0S( ALPHAC) 

GC TC 16 

14 YCMK + 1)* YIN ( 1 )♦ ( XON ( K + l >-X IN ( 1 ) )* CYCXC 

16 CAPPATK+1 ) = C . G 

ALPHA (K+l I = ALPHA (K+l J/PIC180 
K = M1 

IE CONTINUE 

CELS1*SCN (K l-SCN(K-l) 

RETLRN 

ENG 
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SLERCUTIFE LEH <K) 

SiePGuTINE TC CALCULATE POINTS CN A LENNISCATE 

CCFRCN /FCR3SS/ I »OEL S* XBK ( 2C ) » YBK ( 20 ) , XCN ( 500 > , YON ( SCO ) , DYDXO t 500 
l.)»ALPHA(5CC)»CAPPA(5GO) , SON (500) ,P 10180 
CCR'RC-N / ! S / NBDYl,NBCDY2»TYPeDY,NBrYS 
CCFRCN /FAIN/ XIN(IO) ,YIN( 10) f DELS FX,PIC2, CELS 1, IHUR 
CELS IN=DE L S 1 
K = K- 1 
KS TART = K 
CE L S = DEL J 1 

rTHETKX = AlAMABS( ( Y I N 1 3 ) -YI N I 2 1 ) / I X IN I 3 )-X IN ( 2 ) ) ) ) 

A = SORT ( ( <XIN<3)-XIN(2))**2+<YIN<3)-YIN(2))A*2)/(2.0*SIN(2.0*THETHX 
mi 
KCLNTaO 

IF ( Y I N ( 1 ) . EQ • YI M 2 ) ) GO TO 10 
IF (XIN<1 ).EC.XIN<2») GO TO 2 
SLCPE=(Y1M2)-YIM1) > / ( X IN (2 )-X IN(1) ) 

_ARCT=^-TAMSLCPE) ! 

GC TG A 
2 5L€PE*5S«SS. 

ARC T =— PIC 2 
A DC 6 IR0T=>1,3 

XN=XIN(IFCT) 

XIM IROT)=>XK*CCS(AROT ) -Y I N I I ROT ) *S I N ( AROT) 

6 YIM IROT ) a XN* S IN ( AROT )+Y IN ( I POT ) *COS ( A ROT ) 

8 K = K S TART 

1C XCMK + 1) = XIM2) 

YON ( K + 1 ) a Y I N ( 2 ) 

CAPPAi(K+:i )=C.O 
DYCXCXM1 )*C.O 
'ALPHAHK-tl ) =C . 0 
kclnt=kclnt-h 
DS5AVE=0ELS 
CSaCELS 

DTHET=DS«*2/A*A2 
ITHBT-DTHE TA.5 

12 R*A*SQRT(2.G*SIN(2.0*THET) ) 

CSCHEK=R*CCS(THET) 

IF <CSCHEK.GT.1.1*DS) GO TO 1A 
IF ICSCHEK.LT. .PADS) GO TO 16 
DEL !=DS 
GC TC IE 

1A (THE T *= THE T- .02*0 THE T 

GC TC 12 

16 THE T -THET*. 02ADTHET 

GC TG 12 
IE K=K<1 

2C R=A*SQRT(2.C*SIN(2.0*THET) ) 



) 


XCN.I K+'l ) s X I N ( 2 ) - R +CGS ( THET ) 

YCMK + 1) = YIN(2) + R*SIMTHET) 

SCN (K+1)=SCN (K ) + SCRT ( (XCNtK+1 )-XCN {K ) ) **2 + ( YON ( K + 1 ) -YON( K ) )**2 ) 

I F (ABS(«CN (K+1)-SCN(K) tl • G T • 1.0-5 *DS ) GO TO 22 
IF (ABS(SCMK + 1)-S0N(K) ).LT..95*DS> GO TC 24 
GC TC 26 

22 TFET=THET-.C2*DTFET 

GC TC 2C 

24 TFET=THET+.C2*0THET 

GC TC 2C 

26 DYCXC'(K+il )=-TAN(3.0*THET) 

ALFFAKK+1 )=-3.C*THET 

CAPPA(K+ 1 )=3.0*SCRT(SIN(2.0*THET)/2.0)/A 
DStOELS/SCRT(1.C+ABS(CAPPA(K+1) ) ) 

IF ( ABS(GS-OSSAVE ) .GT..25*DSSAVE) C S = OSS A V E + S I GN ( . 2 5 * CS 5 AVE , DS-D SS 
1AVE) 

OS S A VE = CS 

CTFET=5DS4SCRT(SIM2.C*THET) /2.CJ/A 
'TFET = THET+CTHET 
IF (THET.LE.THETMX) GC TC 18 
IF (K0CNT.CT.5C) GC TO 36 

DSTEST=<<XCN(K + 1)-XIM3);>**2+(YCN(K + 1)-YIN(3) )**2)**.5 
IF (CSTEST.GT.DS) GO TO 34 
IF (CSTEST.IT..0CC1*CS> GO TC 28 
IF (CSTES T-.5*0S ) 32,32,30 
26 YCN(K+1)=YIN (3) 

XCN(K+1)=XIN(3> 

GC TC 36 

3C CELS-DELS-CSTEST /FLOAT (K+l-KSTART) 

c-c tc e 

32 CEL S=DEL!+CS TEST /FLOAT (K+l-KST ART) 

GC TC e 

34 CEL S = • 8*E E L S 

GC TC 8 

36 CELS1=DS*1.2 

IF (CELS1.GT.0ELS) 0ELS1=DELS 

WRITE (6,44) KCUN T » TF ETMX , A 

WRITE (6,46) DELSIN,CELS ,DEL S 1 , D ST E S T 

KENC=K+1 

KSTART=KS TART+1 

IF (YINI2 I.EQ.YIMl)) GO TO 40 
CC 26 KRCT-KSTART , K £ N 0 
XN=>CN(KRCT) 

XCMKR0T)=XN*C0S<ARCT) + YCN(KRCT)*SIN(AR0T) 

YCN ( KROT ) = YCN ( KRCT ) *COS ( AROT )— XN*S IN ( ARCT ) 

ALPFAi(KRCT )»ALPHA (KRCT)-AROT 
CYC XC'( KRCT )*TAN( ALPHA (KROT) ) 

3 6 CONTINUE 

AC DC 42 KAl^K START ,KENC 

42 ALPFAIKAL ) = ALPHA (K AL ) /P I C180 

RETURN 

€ 

C 

44 FORMA T ( 2 X , 1 3 , 2X , 1 3H I TE R AT I C NS , 3 X , 1 3HTHETHXC A LC = , F 10 • 5 , 3X , 8HA 

1CALC = »F 1C • 5 ) 

46 FORMAT (2X,10HDELS IN = »F8. 5 ,3X i7HDELS = ,F8.5, 3X, 1 1H0ELS OUT = , 
IF8 • 5i,3X , *HCS TEST * ,F8.5) 

ENC 

YA 
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: $ IBFTC ELL IPS 

subroutine elipse iki 

TMS SUBPCL1INE FITS A SEGMENT OF AN ELLIPSE TO TWO ARBITRARILY 

ORIENTED STRAIGHT LINES NOT PORE THAN 90 DEGREES APART 

COMMON /FAIN/ XIM10)tYIN(lO),DELSPX,Pl02fCELSl, IHUB 
COMMON / F 0 R 3 S S / I , DEL S , XBK ( 20 ) » Y8K 120 ) *XCN ( 500 ) , YON ( 500 ) , DYDXO ( 500 
1 V # ALPHA (SCO) ,CAPPA(5C0) , SON( 500 ) , PI 01 80 
COMMON /«S/ NBDY1,NBCDY2 r TYPeDY,NBCYS 

TRANSLATE INPUT BREAK POINTS SO THAT POINT NO. 2 BECOMES 
THE ORIGIN 

CELS IN=CBLS1 
KGLN T=C 
OE L S*DEL ! 1 
Pl=3.141SS2C53 
KsK-1 

ksiart=k 
X2 S X IN ( 2 1 
Y2=YIN<2) 

CC 2 1=1 i 4 
XIN ( I) =X IN I I )-X2 
YIN ( I)=Y1N (I)-Y2 

rotate TFE TRANSLATED break points so that the slope of the 
FIRST STRAIGHT LINE IS ZERO 

IF (XINI2 I.NE.XIMl)) GO TO 4 
SLOPED* ESS. 

PH I =-P 102 

IF (YINU J.GT.YIM2)) PHI=PIC2 
GO TC 6 

SLC'PE=(YIM2 I-YIN (1 ) )/( XIN(2 )-XIN( 1) ) 

PHl^ATANISLCPEI 

IF ( X IN < 1 ).LT.XIN(2)I PHI~PI*ATAN(SLCPE) 

CC e 1=1,4 
XA*XIN(I) 

XIN( I)=XA*CGS(PHI)+YIN( I)*SIK(PHI) 

YIMI )=->A«SIN(PHI)+Y!NU )*CCS(PHI) 

DETERMINE THE ELLIPSE 

IF ( X IN ) . N E. X I N ( 3 ) I GO TO 10 
B s Y I N ( 3 ) 

A = ABS(XIM3)) 

PHlAe=PIC2 
GC TC 12 

1C SLOP 2= (YIN (4 )-YIN<3 ) )/(XIN(4 >-XIN{3) ) 

IF (SLOP2,LE.2.C*YIN(3) /XINI3) ) GO TO 52 



o rt <*> i-* rt o 


C2=!XIN(3)*SLOP2/YtN(3) 

PH IAE=2.C*ATAN(SCRT ( (C3-2.G ) /C3) ) 

’A *-'X IN(2)/SIN(PHIAB) 

B = Y IN ( 3 ) / ( 1 .G-COS ( PH I AB ) ) 

12 <TFETHX = PF I AP-P102 

TFTHXD=TFETNX/PICieo 

HRITE (6,54) A,R,XIN(l) ,YIN(1),PHI,THTMXC 

INITIALISE THE FIRST POINT CN THE ELLIPSE 

K=K$TART 
XCN '( K + 1 ) * X I N (2) 

YCMKfl): YIN (2) 

C AF P A ( K+; 1 ) =-B / ( A**2 ) 

ALPHA T Ml )=C.O 
CYCXC'<K+1 JiC.O 
KC IN T =KCLN T +1 
THE T =-PI C 2 
CSJAV6-CELS 

OS«CELS/ « l.C+.2*TANH ( ABS (CAPPA( I m ) 

DTHET=iOS/AeS ( A) 

THET=THET+CTHET 

GENERATE THE POINTS CN THE ELLIPSE 
16 K = M1 

IE XCN (K+:l)=-A*COS<THET) 

YCN ( M 1 ) * B * ( 1 .0 + S I N ( THET ) ) 

SON (K+1)=SCN(K)+SCRT( ( XON ( K + 1 ) -XCN < K ) ) **2 + ( YON ( K + 1 ) - YON { K ) )**2 ) 
•IF (ABStSCN (K + U-SC-MK) > .GT. l.O5*0S ) GO TO 20 
IF <ABSI5CMM1»-SGN(K) J.LT..95 + CS) CO TC 22 
GO TC 24 

2C .THET = THET-,C2*DTHET 

GC TC 18 

22 >THET»THE1 + .C2*DTHET 

GC TC 18 

24 IF (THET.EC.C.O) GO TO 26 

CYCXC (Ml ) =B*CCTAN (THET) /A 
AL PH A!( M 1 ) •= AT AN ( CYCXC (K+ 1 ) ) 

GC TC 28 

26 CYCXC (K+l ) =99999. 

ALPHAKK+1 )=PI02 

28 CAPPAf<K+l )=-A*B/ ( B*B*COS ( THE T ) **2 + A* A*S I N ( T HET ) * *2 ) ** 1. 5 

CS=;CELS/(1.0-* : .2*TANH(A8S(CAPFA( I)) )) 

■IF (A8S(C$-0ELS).GT..20*0ELS> DS=0 FLS+S IG N ( . 20 *D EL S , C S-D EL S > 

CS S A YE =C ? 

3C 0ThET=DS/SCRT(B*PAC0S(THET)**2+A*A*SIN(THET)**2) 

CTSsCTHET 

THET*THE1+CTHET/2.C 

CT HET =DS/SCRT(B*G*CCS( THET )**2+A*A*S IN (THET )**2) 

IF (ABS(GTHET-OTS ) .LT..001*0TS) GO TC 32 
GC TC 3C 

22 IF (THET.LE.THETHX-DTHET/2.0) GC TC 16 

IF (K0UNT.GT.1CG) GO TO 44 
CELSS-DEIS 

DSTEST=( (XCN (K+l )-X I N ( 3 1 ) **2 + ( YON ( K+ 1 ) -Y IN ( 3 ) ) ** 2 ) ** . 5 



•IF (ABS(CS-CSTEST).LT..01*DS> GC TC 34 

•IF (CSTEiT.GT.OS) GO TO 42 

'IF <CSTE£7.lT..QI*DS) GO TO 36 . 

IF (CSTE5T-.5*OS) 40,34,38 
34 K*K«1 • ' • 5 ' • 

36 XCN ( K+l ) = X IN f 3 ) 

YCN(K + IMYIN(3) 

GC TC 44 

3E CELS=(FLGAT(KFl-KSTAPT)*DELS+DSTEST)/FLCAT(K+2-KSTART) 

IF TK0UNT.GE.1G) CELS= ( DELS+CELSS > /2.0 
GC TC 14 

4C CEL $ =DEL ! ■•iC STEST /FLOAT ( K + 2-K START ) 

IF (KOONT.CE. 10) OELS= ( OELS+CEL SS > /2 .0 
GC TC 14 

42 CEL $ = . 8*C ELS 

GC TC 14 

44 DEL $ 1 sOS* 1.2 

IF (CELS1.CT.0ELS) D£ LS1 = DEL S 
ttRITE (6,56) KOOM 

*RITE (6,60 DELSIN,CELS,DELS1,CSTEST 
KENC=K+1 

DEeLG (XCN ( I ) » YCN < I ) , I=KSTART ,KEND) ,PHI 

kstart=k«tart+:i 

c 

C ROTATE AND TRANSLATE BACK 

-C 

EG 5C KRC T = K STAR T ,KENO 
XAOCNIKRC1 ) 

XCN ( KROT ) =; X A*COS ( PH I ) — YON (KRCT)*SIMPHI)+X2 
YCN (KRGT ) = X A*S IN I PHI 1 4iY0N ( KRCT 1 *C0$ ( PH I ) -»Y2 
AL PH A!(KRC T ) *A1PHA)(KRCT )♦ PHI 
•IF (ALPHA (KRCT1.E0.P102) GO TO 46 
CYDXC(KRCT)=»TAN(ALPHA(KRCT) ) 

GC TC 46 

46 DYCXOTKRCT )*99999. 

48 ALPHA(KRCT) ^ ALPHA (KRCT) /PI 01 80 

5C CONTINUE 

RETURN 

52 WRITE (6,56) SL0P2 ,X I N ( 3 ) , Y I N ( 3 ) 

STCP 

C ■ 

C 

54 FGPNAT (1HC,10X,4HA = , 1 PE 10 . 3 , 5 X ,4Hfl = , 1PE 10. 3 , 5X , 5HX0 = ,1PF1G. 

13 , 5X , THYC '* ,1PE10.3/9X,7HPHI = , 1PE1C. 3 , 5X , 9HTHETMX = ,1PE1C.3 

2.1 

56 FCRNAT ( 1 IX, I3,2X*13FITERATICNS ) 

56 FCRNAT ( 1HC , 10X,42HCCHB I NAT I CN OF SLOPE, X , Y NOT C0MPATIBLE/5X,9 
1HSLCPE2 * ,F7.3,3X,9HXIN(3> = , F7. 3 ,3X ,9HY IN( 3 ) = ,F7.3) 

6C FCPNAT ( 1 1 > rlOHDELS IN = ,F8 .5 , 3X ,7HCELS = , F8 . 5 ,3X , 1 1HDELS OUT = 
1,F6,5,3X,9FC$TEST = ,F8.5) 

ENE 


HS 



41B'FU PROPS 


SUE ROUTINE PRELPS ( KCOE , K AT , I A , K I ,K 2 > 

CCN NGN /FAIN/ XI M 10 ) , Y I N< 10 ) *DE LSNX , P IC2 , CELS1 , IHUB 
OCNNGN /FCR3SS/ I ,DEl S', XBK ( 20 ) , Y BK < 20 ) , XCN <500 ) ,YON( 500 ) , DYDXO I 5Cu 
1 ) , ALPHA (*CC )*CAPPA(5C0)*S0N( 500 ) , PIC 180 
CON NGN /<PREP/ KFREP 
KPREP = 1. 

IF (KAT.EC.l) GC TC 20 

K I C=KOOE 

X1=XIN(1) 

Y 1 * Y I N m 

IF (IA.EC.5) GC TC 2 
XC-XIN(A) 

YC = Y IN ( A ) 

GC TC 4 

2 XC = X I N ( 5 ) 

YC= Y IN ( 5 } 

4 DC 14 IB-1, IA 

GC TC (6,8,10*12,8,12) ,KODE 
6 YIMIB) = UMIA)-(YIN(IB)-YIN(IA) ) 

GC TC 14 

18 X1M IB ) = > IMl )-<XIN< IB)-XIN(l) ) 

GC TC 14 

1C YIN( 1 8 ) = Y I N (lJ-(YIN(IB)-YIN(l) ) 

GC TC 14 

11 XIN( IB)*) IN ( I A)- (XIN(IB)-XIN(IA) ) 

14 CONTINUE 

DEetC-IXIMII ,1 = 1 ,IA) , (YINU) ,1 = 1,1 A) ,KOCE 
IF ( KODE . EC • 5 ) GC TC 16 
4F (K00E.EC.6) GC TO 18 
RETURN 
16 KCCE=1 

GC TC A 
16 KCC E = 3 

GC TC 4 

2C DC 22 IB*K1,K2 

GC TC (22 ,24,26,28,22 ,26) ,KIC 
22 YON ( IB)=YC- (YON( ie)-YC) 

GC TC 3C 

24 XGN ( 18 ) = > 1- ( XCN ( IB )-X 1 ) 

GC TC 30 

26 YCN( IB)=Y1-(Y0N(IB)-Yi) 

GC TC 30 

28 XCN ( IB)=XC-(XON( IBJ-XC) 

3C DYCXCl IB)=-CYDX0(I8) 

32 CONTINUE 

DEBUG! XGN ( I ) , I =K 1 ,K2 ) , ( YCN ( I ) » I =Kl ,K2 ) , K ID ,K 1 ,K2 
IF ( K I D.EG. 5 ) GO TO 3 A 
IF '(KID. EG. 6) GO TO 36 
RETURN 
34 WIC=2 

GO TC 2C 
N I C = 4 
GC TC 20 
ENC 

V6 


36 
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'$ I6FTC TEST. 

SUBROUTINE TEST CIA) 

COMMON /MA IN/ XINUO) ♦YIN(10).DELSMX,PIC2tCELSl, IHUR 
COMMON /FCR3SS/ I , OEL S . XBK ( 20 ) , YBK ( 20 ) , XCN ( 5C0 ) , YON ( SCO l , DYDXO ( 
.1), ALPHA < SCC ) »CAPPA(5CO)>S0N(50O) .PID180 
COMMON /SPREP/ KPREP 
M=IA-1 

IF (XIN<2 KEQ.XIMin GO TO 2 
$LP1*(YIN C2)-YIN(1))/(XIN(2)-XIN(1) ) 

GO TC A 

2 SLPls99S«S. 

'IF IYIN(2».GT.YIN(M).AND.XIN(2).LT.XIN(P)) GO TO 1C 
A 'IF <XlN(l).EC.XIN(M> ) GO TO 6 

$LP2=(YIMF)-YIN(1))/ <ximm)-ximi > ) 

GO TC 8 
SLP2=99S«S. 

. . ' ' . \ 

ROTATION ONLY 

IF ISLP1.GT.SLP2) RETURN 

MIRROR IMC X I N ( 1 ) 

GALL PREIPS (2.C.IA) 

RETURN 
ENO 


C SMIR CECK.LIST 
SUBROUTINE M IRRCR IK.YCL ) 

THIS SUBPCLTINE MIRRORS THE HUB TO OBT AIN THE POINTS ON SHROUD 
l S E 0 FOR 22 Y - 2-0 INLETS 

COMMON /FCR3SS/ I , OEL S f X«K ( 20 ) , YBk ( 20 ) , XCN ( 500 ) , YON ( SCO ) , DYOXO ( 5C0 
1 V, ALPHA ( SCC ) ,CAPPA (5C0) * SON <500) ,PIC180 
COMMON ✓ 2 S / NBDY1 , NBC0Y2 .TYPEDY , NBCYS 
CO 2 J=l,NeOYl 
K = K 4 , 1 

TSTAR^1+;Z#N80Y1-K 
XCN ( K ) =X0 N ( I STAR ) 

YON (K ) =2.0* YCL-YCN ( I STAR ) 

CAP PA (K)=-CAPPA( I STAR ) 

DYCXCC K ) =-C YOXOT ISTAP) 

»LPHAi<K)*-ALPHA( ISTAP ) x 

SON ( K ) =SCN ( I STAR ) 

CONTINUE 

WRITE ( 6 i A ) YCL 

RETURN 

FORMAT (23HHUB MIRRORED INTO Y CENTERLINE = ,F8.3) 

€NC 

V7 


un 
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<*I6FTC SIMP 

"SLiePCUTINE SINTP < Z »V ,N , XI , V 1 ) 

D I P EN S IGft X ( 2CG ) , Y(200)» Z(2C0), V.1200) 

CC 2 1=1, N 
X ( I ) = Z (I) 

2 Y(I)=W(l) 

CALI SCRTXY (X,Y,N) 

t 

OC 4 1=1, N 
K=I 

IF TX1.GT .X I 1)1 GC TC 4 
«IF (Xl.EC.Xd) ) GC TC 6 
IF (Xl.LI.X(I) ) GC TC 8 
CCMINUE 
Y 1 = Y ( K ) 

GC TC 1C 
G *IF (K.EC.l > GO TC 12 

*IF (K.EC.N) K=N- 1 

*1= < Xl-XIK ) )*IX1-X<K+1) ) /<X(K-1 )-X <K ))/(X(K-l )-X (K + l ) ) 
«2=( X1-XIK-1I )*CXl— X(K+1))/(X(K)-X(K-1))/(X(K)-X(K+1)) 
N3 = ( Xl-XtK-1 ) )*<X1-X(K) ) /(XIK + 1 1 -X ( K- 1 ) )/( X(K+1 )-X(K ) ) 
Y1 =y<K-1 J*K14Y(K )*K2+Y(K + 1)*V.3 
1C PE TURN 

12 Yl=C.O 

RE URN 
ENC 
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5LEPCUT IF E SUPERC ( XP RK , YBRK , ENREEC , CELS 1 , I ST ART ) 

CIFEKSICN XERK ( 5 ) , YRRK(5), XBKH12), YeK 1 ( 12 ) 

ECU I VALEFCE IN.EM 
REAL LOOCA .LOGYCB ,N 
CCPPCFI /SLPF/ IFLC 

CCKKCN /FCR3SS/ I ,DEL S , X8K 1 20 ) , YBK ( 20 ) , XCN ( 5C0 ) , YON ( 500 ) » OYDXO ( 5C0 
1),ALPHA(5CC)»CAPPA(5CO)»SON( 5GQ ) ,P 10180 
CCPPCN / SUP N / XCA,Y0R,LCGX0A ,L0GYCR 
CCPKCN /FHIGH/ N £ PHG , NL A ST * X L AS T ( 5C0 ) , YL AST ( 500 ) 

CCFKCN /! PREP/ KFREP 
' il P I = C 

P 1 = 2. 1415 9265 

IF (IFLC. EC. 1) CEL SHL =DELS1 
EELS IN=DE L S 1 
CE L S 2 =DEl S 1 

KCLM =C . 

2 11 = I START 

IF (IFLD.GE.l) DS=DELS2 
KCLM-KGLNT + 1 
1=1 START 
X4 T=XBRK (A ) 

<Y4 T = YBRK ( 4 ) 

DC A J = 1 , 5 
’XEKl(J+71 = >eRK(J) 

-YBK1 ( J + 7 ) = YBRK ( J ) 

■ 4 CCMINLE 

! DERLG(XBK1 (J)VYBKK J) ,J=8,12) 

IF CXBK1 ( $ ) .NE.XRK1 (8 ) ) GO TC 8 
IF (YBK1(8).LT.YBK1(9)) GO TC 6 
SLGP*99S«9. 

S I N A 1 D = 1 • 0 
^LCPE^SS*'?. 

AT C Y DD=9C • 

CO S A T D=C • C 
GC TC l A 

fc *SLCP-~99®99 • 

SINATD=-1.C 

SLGPE=-««SS9. 

ATG YCD=-SC • 

CCS ATD=C ,C 
GC TC 14 

•8 SLCP=(YBH1(9)-YBK1(8) )/(XBKl (9)-XBKl(8) ) 

■SLCPE = ATAMSLOP) 

ATCYCD=SICPE/PI0180 
IF (XBK1 (8 J-XBKl (9) ) 10,12,12 
1C SLCPEtPHSLGPE 

"AT C Y CD=- A TC YOD 
IP 1 = 1 

12 «IMATD = SIFI (SLOPE ) 

CCSATO=CCS( SLOPE) 


V? 



14 CCMINL'E 

XB.K ( 6 ) - XB K 1 1 8 ) 

YBK(6)=YEK1(8) 

CC 16 J = 9 ,12 

■XP = XBK1 (« )~ XBK1 ( 8 ) 

YP=YeKl(U)-YBKl(e) 

■XBK ( J1=XEK1 (8 )+XP*C0SATD + YP*SIN4TC 
YBK(J)=YEK1(8)-XP#SIAATD+YP*C0SATD 
16 CONTINUE 

fXBK ( 5 ) = X E K (8) 

.YBK ( 5 ) =YB K ( 8 ) 

XBK ( £ ) =XE K ( 9 ) 

YfiK ( 6 ) =YE K ( 9 ) 

XE K ( 9 ) = X.E K ( 1C ) 

YBK (9)=Y8K (10) 

CEL S-OEL 5 1 
dssave=cel$ 

XTP = XBKl <9 ) 

YTN-YBKl ( 9 ) 

E=YBK< 1U-YBKI6) 

JTCN EG A = < >BK ( 12 ) - XBK ( 1 1 ) ) / ( YBK ( 12 )-YBK (1 1 ) ) 
HF (ABsHCKEGA ).LE..C001 ) TCKEGA=0. 
CNEGA=A7/N (TOWEGA ) 

XC*XBK(C)*B*TOP,EGA 
fYC = Y B K ( 1 1 ) 

A=>C-XBK|1 1 ) 

X I 9 = XQ-XE K ( 9 ) 

ETA9-YC”7BK (9) 

Y = E 1 A9 

l X=XI9-ETA9*T0MEGA 

BCA=e/A 

>1 F (ENREEC) 18,16,20 
IE XCA=X/A 

YCB=Y/B 

lCCXCA=ALCG(XOA) 
tCGYCB=ALCG (YOB) 

CALL FCN1SC CEN) 

GC TC 22 
2C EN=ENREEC 

22 BGA7CN=BC A**EN 

IF (KOUNT.AE.1) GC TC 24 
fcRITE (6,114) EN,A,B,XO,YO,GKEGA 
24 >1 = 1 

•I L G = I 

* XCA ( I ) =XCN ( 1 1 ) 

C1CM1./EN 
BT=e*TOKEGA 
CX1=CELS*CCSATD 
XP = X7M-XE K 1(8) 

!YP : - Y TH-YE K 1 (8.) 

XI1RGT=XEK1 <8)+XP*CCSATD+YP*SINATD 
XMXC-XI 1RCT 
Y= YC-YBK ( 6 ) 

X = X i-Y*1CKEGA 

iIF (X.LT.C.C) X = C.C 

DSK = SON( 1 ) - SON ( I - 1 ) 


50 



24 XCA70N=()/A)**N 

:YC87CN=0/B)**N 0 

*N*CAN = X*’MN-1.) /A**h 

*N*CPN=Y«*(N-1.)/B**K 

FCFY=X0A1CN+Y0B7CN-1. 

7F <ABS(FCFYI.LE.l.CE-5) GO TO 28 
FPCFY=EM* (YKPOBN-XNPC AN*70HEGA> 

YNEV=Y-FCFY/FPOF V 
GC 70 3C 
2£ YNEP=Y 

3C IF (ABSO-YNEWJ/YNEW-.1E-4) 34,34,32 

32 ■YsVNEVl 

X*> I-Y*7CPEGA 
GC 70 26 
34 W»YNEW 

X*XI-Y*7CPEGA 
36 E7A = Y 

CEL S b OELl 2 
I P N * l 

4F (X.L7.C.C) X=C.C 
XCANP1 = <»/A)**(EIS-1. ) 

VCBKMMVe )**(EN-1. ) 

F 1 =XC ANP ] / A 
F2*YCBNP] /E 
F3*7CMEGA*F1 
IF (X.EC.C.C) GC 70 38 
FlCX*X**(EN-2. )/A**EA 
GO 70 4C 

3 £ IF (EN.EC.2.) F1CX=1.0/ ( A*A) 

>IF ( EN.G 1 • 2 • ) FICX=0.0 
4C IF (Y.EC.C.C) GC 70 42 
F2CY-Y**!EN-2. >/B**EA 
42 CEK=F2-F! 

IF (CEN.FE.C.O) GC 7C 44 
£E70XI=5<S59. 

GO 70 46 

44 DE7C>I=-F1/CEN 

46 CY C XC’( IPN ) =C E7DX I 

C1PEPT=1.-CE7DXI*7CPEGA 

4F (<X.EC.C.0,0R.Y,EC.0.G).AND.EN.L7.2.) GC 70 48 

Gl= (EN-1. >*F10X*CIPEF7 

SANC1-0EMG1 

SANC2==F1* ( (EN-1. )*F2CY*DE7DXI-G1*70MEGA) 

BK7s(l.^CE7CXI**2)**1.5 

CAPPA ( IPM = (SAN02-SAA01»/0EN**2/eK7 

GO 70 5G 

4£ CAPPAUPN) = 99999. 

5C AlPFAI IPM»ATAN(CYDXCUPN))/PI0180 

XCM IPNI*XC-XI 
*GN(IPfO=YC-E7A 
DY1=CELS*SINA7D 
IF (IFLC.GE. 1 ) GC 70 52 
D$ = CELS/1 1. G4.20*7ANMABS (CAPPA ( I) ) )) 

GO 70 56 

52 -IF ( IFLC.G7.1 ) GC 70 54 

OS*CS-.C«*CS f 


57 





r " 




GC 1C 58 

ds=cs ..■•/;•■ ’■ 

IF (CS.GI.CELSHlI OSaOELSHL 
GC TC 58 

•IF (ABS(CS-DEL$).GT..20*DELS) DS = DELS + S IGN < . 20*CELS , CS-DELS ) 

•IF (CS.L1..50*0ELS2» DS=.50*CELS2 
IF (NSPHC.EC.O) GC TC 60 
DX1 = ABS(:>LAST(NLAST)-XLAST(NIAST-1) 1 
DX11=DX1 ‘ 

DYl = ABSOLAS7<M$S7)-YLASTlNLAST-l ) 1 
NlAST=NLAST-l » 

•IF ( ABS<OETOXI1-1.) 70,70,62 

CY1=CS/SCRT<1.+1./06T0XI**2> •• 

IF (NSPKC.NE.01 0Y1-CX1 

* TP= YON ( I ) ♦tSY 1 , ; ■ : f 

IF (YTM-Y8K (11) ) 66,86,86 

ETA-YO-YTM / - 

Y = E 7 A . ■ 

STB A IGH7 SECTION BETWEEN POINTS 11 ANO 12 PUST HAVE, SLOPE ABOVE 1 


•X PAY NOT- BE .TESTED AGAINST XBKIlli 


X = A4 ( 1«” I Y/8 1 **N T**C1CN 
•XI = MY*TCPEGA 
•XTP * XO-X I 

□ Xl-XTP-XCMII A a 

CELTAS=SCRTIDY1**2+0>1**2)W 9 

IF ICEL7#S.GT.1.02*0S.AN0.1PN.NE.1.AN0.NSPHG.E0.G) go 
GC 7C B6 

CYl’CS* 071/ DELTAS 
GC TC 64 

CX1*CS/SCRT (l.+DETDXI**2 ) 

•IF (NSPHG.NE.O) CX1*CY1 , - 

•IF (NSPHC.NE.0.4N0.IFI.EC.I) 0X1 = 0X11 

x7P=xONm*siGNioxi,c6Toxn 

’IF (CETOI.EG.C. ) XTP*X0NII l-oxi ; • 

XI=XC-X7F 
Y = YC-YOM 1 1 
x=xi-y*tcpega 

IF ’(X.LT.C.C1 X=C.O , 

XCA TCN= ( > / A > **N 
XNPCAN=X#*(N-1.)/A**N 
*NPCEN=Y«*IN-1.)/B**N 
Yce7CN=rv/e )**n 

FCFY*X0ATCK + Y0BTCN-1. . v .- . 

IF (ABSIFCFYKLE.l.OE-51 GC TO 76 
FPGF YsEN* I YNPGBN- XNPCAN*T OMEGA ) 

YNEW-Y-FCFY/FPOFY 
GC TC 78 
!YNEW*V 

IF ( ABS (.7- YNE VI ) / YNEW- * IE-4 ) 82,82,80 
.Y = YNEW 
GC TC 74 
Y=YN EX 



X*Xl-YMCNEGA 
‘ YTMYO-Y 

X I'= X ♦ Y * T C F E G A 0 
C DY1=YTN-YCN ( I-l) 

OYl=YTN-YCN ( I ) 

1 DELTAS=SCRT (DY1**2*DX1**2) 

IF (DELTAS. GT.1.02*DS.AN0.IPN.NE.l. AND. NSPHG.EQ.O) GO TO 84 
GC TC 86 ti 

m 0X1=CS*D>1 /DELTAS / 

GC TC 72 

86 SCN ( I ) =SCN ( 1-1 1+CSK 

CS^f'C'S ' 

IF (NSPHC.AE.O) D S = DX 1 

IF (ABS(YTP-YBK(lin.LT..001*DS) GC TC 90 
4 = HI 

•IF {YTN-YBK(lin 36.68,88 
8 6 I H I = I - 1 

; GC TC 92 
9C *1 F I s I 

*I*H1 

92 XTF=XBK(11) 

DC 1C8 J* I LO, IHI 
XP*X0N( Jl-XBKl (8 ) 

YP * YON (J)-YBKI (8 I 

XCMJ)=XEK1 (8HXP*CCSATD~YP*SINATD 
YCN( J)=YEK1 (8)+XP*SIKAT0+YP*CCSATD 
DEL22-DEI S2 

IF U.NE.IHI) GO TO 104 

CSTEST=< (XCN ( IHI >-X4 T ) * *2+ ( YCN ( I HI )-Y4T 1**2 )**. 5 Ml 

IF (KOUNT.GT.150) GC TO 104 
•IF (ABS(CS-CSTEST).LT..H‘DS> GO TC 94 
: IF (CSTEST.LT..0HDS J GO TO 96 

IF < IHI. EC. I LO) GC TC 102 

IF (ABS(CELS2-DS7ESTJ.LT..001*DS> GO TO 100 
'IF (CSTEJT.LT. .5*CS> GO TC ICO 
IF (CSTEJT.CT..5*CS) GO TC 96 
94 4Kl*lHHil 

>I = H1 

SCM IHI)»SCN( IHl-lHCSTEST 
-96 ’XCN ( IHI I 3 X4T 

YCMIHIHY4T 
GO TC lC^ 

98 0ELS2=(FICAT( IH I - I LO ) 4DELS26CSTEST ) /FLOAT ( IHI + l-ILO) 

IF (K0UNT.C-E.10) DELS 2= ( DELS 2 +DEL2 2 ) / 2 .0 
I s IlG-1 

GC TC 2 . . 

ICO CELS2=DELS2+DSTEST/FLOAT (IHI-ILO) 

■IF J(KOUNT.GE.IO) DEL S 2= ( DELS 2 + DE L22 ) /2 .0 
4 = ILG-1 
GC TC 2 

1C2 CELS2=u8*DELS2 
4* IlG-1 
GC TC 2 

1C4 ALPHA* J HALPHAUI-ATCYDD 

>1 F ( ABS I AB S (ALPHA (J) )-90.).LE. 1 .0E-4 ) GC TC 106 
DYCXC!( J) = TAN (ALPHA (J)*P 10180 ) 
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^ <*» 


GO TC lOt 

106 OY(J XG’I J ) - S IGN 1 99S« , ALPHA ( J ) ) 

ICO CONTINUE 

IF (KOUNT.GT.t50) WRITE 16,116) (XBRK < IJ,YBRK( I ) ,1=1,5) 

DELS l^DS 

IF (IFLC.EC.O DELS1=1.1*DS 1 

IF ( DELS 1 «G T.DEL $2 ) CELS1=DELS2 , 

CO 112 J»! I L 0 , I HI 

IF (J.EC.l) GO TC 11C , 

SON ( J)=SC<N( J-1)*SQRT((X0N( J)-XON( J-l) )**2+(Y0N( J )-YON(J-l ) )**2> 
GO TO 112 
110 SON ( J ) =C.C 

112 CONTINUE j 

WRITE (6,118) KOUNT 

WRITE (6,120) 0£LSIN,0ELS2»0ELS1 , DSTEST 
RETURN 


14 FORMAT (1X/4X4HN * E16.8.4X4HA = E16.8,7X4HB = E16.8/3X5HX0 = E16. 
18, 2X5HYC => E16o8*3X8H0MEGA .* E16.8/1X) 

116 FCRMT (1HC.60HTHIS SET OF DATA EXCEEDED 1 50 1 TER AT IONS CALCULATION 
1$ STCPPEC/5X,4HXBRK,5X,AHYBRK/5X,1P10E10.3) 

118 FORPAT (IX, 5X413, 2X,13H ITERATIONS*"”) 

120 FORMAT (6X , 10HDELS IN = ,F8. 5,3X ,7HDELS = ,F8.5,3X, 1 IHDELS OUT = , 
IF 6 • 5 , 3X , SHC S TE ST = ,F8,5) 

ENC ’• 






* 

( 


i 


\ 


Sf 


* 


«N* WWW 


'tlBFTC ARE AA 



'SLBRCUT I NE ARE AA 

CCPPCN / 5 S ✓ NBDY1,NBC0Y2,TYPEDY,NBCYS 

CCPPCN /FCR3SS/ I ,D£L S , X0K ( 2C > » YBK ( 20 ) » XCN ( 5CQ ) ,Y0N( 500) ,DYOXO< 5*30 
U,ALPHA(«CC ) t CAP PA (500) , SON ( 500 ) ,P 10180 
CO PON / P N S D / NN SO »NS0BD Y ( 10 ) 

CIPENSICN JPAX(2C), JHIN<20), YL$(20), YHSC20), AREA $ ( 20 ) , YAR(20) 
P I'» 2.1415S265 

NBP1=NBCY 1*1 V/' 

DC 2 J=NEP1,NB0DY2 
JJ = J 

IF (XONU ).LT.XCM J ♦ 1 ): ) GO TC 4 
CCNTINUE 
KRIIE (6,26) 

‘IF (NNSC.EC.C) GC TC 14 

SEARCH FCR P INI HOP AND HAXIHOM X ON EACH NSD (SPLITTER) 

NE^NEODYl + 1 
NE=NEOOY 2+NSDB0Y(l) 

CO 12 1 = 1 ,NN SD 
•XH IN^XOMNE ) 

gPIN( I )=AB ° 0 

XPAX=XCN (NE ) 

JPAX ( I ) =NB 
NEP 1 =NE- 1 
CO 1C J=?N8 ,NEH1 
IF ( XON (« ) .GT . XP A X ) GO TO 6 
IF ( XON («i ) • LT • XP IN ) GO TO 8 
GO TC 1C 
6 XPAX = XOMJ) 

JP A X ( I ) = 0 
GC TC 1C 

>6 XH IN* XON ( J 1 

: JP IN ( I ) =«! 

1C CONTINUE 

NB s NE+;i 

NE=NE+’NSCECY ( I + l ) ■ W 

1 WRITE (6,26) XHIN(,XHAX,JHINU) , JHAX( I) 

12 CONTINUE L< 

14 DC 24 J=NBP1 , J J “ 

I A* 1 

CALL SINTP (XCN,YCN»NBDY1,X0N(J) ,YAR(IA) ) 

IF (NNSC.EC.C) GC TO 18 * - 

‘JENC = NBCC Y2 
DC 16 1 = 1 ,NNSD 

JHI = JMIMI) • ’ 

JPA- JMAX ( I ) 

JENC = NSDE DY ( I ) + JEND 

•IF >( XON (« ) . GT.XONT JPA).OR.XGMJ).LT.XCN(JMI) ) GOTO 16 

*i a = i a +: i 


$s: 

0 


0 



i : 


CALL SIN TP <XON( JMA) ,YON(JMA) , JP!I-JMA+l',XCN( J ),YAR( IA t ) ) 

IA = IA-*!1 

GALL SINTP (XCN< JPI) ,YON < JMI ) , JEND- JM l +1 ,XCN ( J) ,YAR( IA) ) 

16 CONTINUE 

If ! I A 3 J A ■*■ 1 

YAP ( I A )=YCN ( J ) 

IS=C 

AREA=O.C 
DC 2C 1 = 1 » I A v 2 
I S-IS+M 

AREAS ( IS (YARU + 1 k**2-YAR( I)**2)*PI 
iAREA = AREA + AREAS( IS ) 

2C CCMINUE • 

AREAC-AREA*YAR(1)**2*PI 
IF (NNSC.EC.C) GC TO 22 
WRITE (6,30 (AREAS! I), 1=1, IS) 

22 WRITE (6,32) J ,XC-N ( J ) , YON( J ) ,YAR ( 1 ) , AREA , ARE AC 
WRITE (6,34) 

24 CONTINUE 

RETURN * 

c 

26 FCRPAT ( 1H1//9X,1HI , 1 4X , 3HXCN ,1 8 X , 3HV0N , 19X , 4HY0NH, 1 7X , 4HARE A, 1 4X, 
19HCISC AFEA) 

2E f CRN AT UHC,5X,7HXPIN = , 1PE 14. 5 ,5 X , 7HXP AX = , IP E 14 . 5 , 5X , 7H JMIN = 

1 ,16 ,5X,7F JPAX = ,16) 

3C FCRPAT (T4X.1PE21.4) 

22 FCRPAT (£X,I3,1P5E21. 4) 

34 FCRPAT (1HC) 

ENC 


•t IGF TC N SCRCL 


£ 

c 

c 


2 

4 

6 

e 


1C 

12 

t 

14 


FIND N FCR THE SUPERCIRCLE F (N) = (X/A)**N +'(Y/E)**N -r 1 = 0 
FRCP X,Y,A,P 

SUBPCUT IN E FCNISC (N) - 

REAL LOG>CA ,LOGYCB 

CCPPON / S UFN / XCA%YOE ,LCGXOA ,LOGYGE 
REAL NM »N P P 1 » N 
CATA TCL / • 1 E-6/ 

IF ( AB S ( >C A-.5 )- .5 ) 2,4,4 
IF ( A8SOCe-.5)-.5 ) 6,4,4 
WRITE (6,14) XO A , YOB 
NP - 1 . 

■XC ATCN=XC A * * N P 
YCETCN=YOB**NM 
FCFN*X0ATCN*Y0BTCN-1. 

FPCFN = XGA TCN'*LOG XC A + Y0BT0N4LCGYCB 

NPF1»NP-FCFN/FPCFN 

IF ( ABS(NP-NPPl) /NM-TOL) 12,10,10 

NP'=NPP1 

€C TC 6 

N 3 N P P 1 

RETURN 

.FCRPAT (1X/1X,41HREQLESTED POINT IS OUTSIDE MAGIC TRIANGLE) 
ENC 




0 




SLBRCLTINE SIMC 
PURPOSE 

0B1AIN SOLI. T I ON OF A SET OF SIMULTANEOUS LINEA 
A X* 8 
USAGE 

CALL.. SiWC(A,8»A,KS) o 

DESCRIPTION OF PARAMETERS 

A - MATRIX CF COEFFICIENTS STO.RED COLUMNWISE. 
CESTROVEO IN THE COMPUTATION. THE SIZE OF 
N BY N. 

B - VECTOR CF ORIGINAL CONSTANTS (LENGTH N». T 
REPLACED BY FINAL SOLUTION VALUES, VECTOR 
N - NUMBER CF EQUATIONS AND VARIABLES. N MUST 
KS - OUTPUT DIGIT 

0 FOR A NORMAL SOLUTION 

1 FOR A SINGULAR SET CF ECUATIONS 

REMARKS 

MATRIX A MUST eE GENERAL. 

IF MATRIX IS SINGULAR , SOLUTION VALUES ARE ME 
AN ALTERNATIVE SOLUTION MAY RE OBTAINED BY USI 
- INVERSION (MINV) AND MATRIX PRODUCT (GMPRD). 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
NONE 

METHOC 

METHOD OF SOLUTION IS EY ELIMINATION USING LAR 
DIVISOR. EACH STAGE OF ELIMINATION CONSISTS OF 
RCVS WHEN NECESSARY TO AyOID DIVISION BY ZERO 
ELEMENTS. 

THE FORWARD SOLUTION TO OBTAIN VARIABLE N IS C 
N STAGES. THE EACK SOLUTION FOR THE OTHER VARI 
CALCULATED eY SUCCESSIVE SUBSTITUTIONS. FINAL 
VALLES ARE DEVELOPED IN VECTOR B, WITH VARIABL 

VARIABLE 2 IN B(2I» , VARIABLE N IN BIN 

IF NO PIVOT CAN BE FOUND EXCEEDING A TOLERANCE 
THE MATRIX IS CONSIDERED SINGULAR AND KS IS SE 
TOLERANCE CAN BE MODIFIED BY REPLACING THE FIR 


SUBROUTINE SIMQ (A,B,N,KS) 
DIMENSION A(U, 8(1) 

FORWARD SOLUTION 
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R EQUATIONS, 


these are 

MATRIX A IS 
HESE are 

X . 

RE .GT. ONE. 


ANINGLESS. 
\'G MATRIX 


CEST PIVOTAL 
INTERCHANGING 
CR SMALL 

ONE IN 
ARLES IS 
SOLUTION 
E l IN B ( 1 ) , 

>. 

OF O.O, 

T TO 1. THIS 
ST STATEMENT. 



<? 


c 

TCL«0.0 
KS = C 

DC 16 J = 1,N 
JY=J*1 
JJ = JJFN+,1 
BIC-A = 0 

it-jj-j 

CC 4 t=J,N 

c 

C SEARCF FOR MAXIMUM CC EFF I C I ENT . IN COLUMN 

C 

ij*ihi ft 

. IF (ABS(EIGA)-ABS(A(IJ)) ) 2,4,4 

2 BICA*A(I4) 

INAX*I 

4 CONTINUE 

C 

C TEST FCP PIVOT LESS THAN TOLERANCE (SINGULAR MATRIX) 

C 

IF (ABS(EIGA)-TCL) 6,6,8 
fc KS*1 

RETURN 

C 

1C INTERCHANGE RONS IF NECESSARY 

c 

>e iihj+nmj- 2 ) 

•IT* IMAX-; 

CO 1C K^J,N 
41*ii+:n 

12= I HIT 

save*aiii > 

A ( 1 1 )=A ( I 2 ) 

'A ( 12) *SA \ E 

c 

t CIVICE EQUATION 8Y LEADING COEFFICIENT 

C , . 

IC lAIIlHAim/BIGA 
SAVE=B(INAX) 

B(IMAX)=E(J) 

BUHSAVE/BIGA 

c 

IC ELIMINATE NEXT VARIABLE 

C 

if (J-N) 12,16,12 
12 ICS=N*(J-1) 

CC 16 I X* J Y , N 
»I X IOS^ I X 
«HJ-IX 
DC 14 JX = J Y , N 
IXJX»N*(^X-1 HIX 
JJX=lXJXTn 

14 A( IXJX)=A ( I X JX )-.( A ( I X J ) * A ( J J X ) ) 

16 B( IX)=B( IX)-CB( J)*A(IXJ) ;) 

C 

c eACK SOLUTION 

c 

IE NY*N-1 

,IT=N*N 
CC 2C J 4 1 , N Y 
<IA = IT-J 
<e-N-j 
•IC-N 

DO 2C K= 1 , J 

8(IB)=BI IB J-AIIA )*BUC) 

•IA^IA-N 
2C *IC = IC-1 

RETURN 
END 

sr 


o r> n o o o o 


EOD 

$ IBFTC EOO DECK 

C* *♦ DOUGLAS NEUMANN POTENTIAL FLOW PROGRAM ** 

* CALCULATION OF POTENTIAL FLOW ABOUT BODIES OF 
REVOLUTION HAVING FLOWS PARALLEL AND PERPENDICULAR 
TO THE AXIS OF REVOLUTION. 

* MAIN PROGRAM 

COMMON / NBSAVE / NBCLD , NIN 
NBOLD =* 0 


COMMON 

HEORUO) 

.CASE 

, NB 

»NNU 


1 

. FLG03 

. FLGOA 

. FLG05 

.FLG06 

.FLG07 

2 

> FLG08 

. FLG09 

, FLG10 

.FLG11 

»FLG12 

3 

t FLG13 

, FLG1A 

« FLG15 

»FLG16 

. FLG17 

A 

t FLG18 

. FLG19 

. FLG20 

♦FLG21 

. FLG22 

5 

. FLG23 

. FLG2A 

t FLG25 

»FLG26 

.FLG27 

CCUBLE 

PRECISION HEDR, CASE 




INTEGER 

FLG03 

.FLGOA 

. FLG05 

.FLG06 

. FLG07 

1 

• FLG08 

. FLG09 

t FLG10 

»FLG1 1 

. FLG12 

2 

» FLG13 

• FLG1 A 

» FLG15 

»FLG16 

. FLG17 

3 

. FLG18 

. FLG19 

. FLG20 

»FLG21 

.FLG22 

A 

. FLG23 

, FLG2A 

. FLG25 

.FLG26 

. FLG27 

COMMON 

NT 

. ND( 11) 

.MN 

,NUNA( A) 

. TYPE A ( A) 

1 

. NER1 

,NER2 

. NMA 

tNSIGA 

.NSIGC 

2 

, NUNC(A) 

, TYPEC(A) 

> NLF ( 11 ) 



COMMON 

IEC » NSIGECt 

TYPE EC (A), 

NUNECIA) 




COMMON /P/ IPUVEL 
REAL MN 

C 

REWIND 13 
10 REWIND 12 
REWIND A 
REWIND 3 
REWIND 8 
REWIND 9 
REWIND 10 
REWIND 11 
REWIND 15 
REWINO 16 ' 

CALL PARTI 

C*** ♦••PRESCR I BED VORTICITY IMPLIES TR I ANGULAR I ZATION METHOD OF MATRIX 
'C.«.M ••♦SOLUTION (SOLVIT! 

IF ( FLG19.GT . 0 .OR . FLG 1 3 .GT. 0 ) GO TO 30 
15 CALL PART2 

GO TO AO ' . 

30 CALL PREP 
AO CALL PARTA 
GG TO 10 
ENO 


5 ? 

,) 




4 ; ■■ ’ deck ' 

SUBROUTINE PUNCHCIR, J,L0C,CASE) 

>*•■■ :=:!'■> Z::- ' ' CfM ENSIGN R(AOO) 

;• c';^'C-.; ; '. v V^ RETURN - 
■■■;. -t-v*?;- ;: ENC 


- .^I.I BFTC TIMEX DECK 



SUBROUTINE TIMEV(T) 
CALL TIKE l (T ) 
T*T/3600. 

RETURN 

END 


IIBFTC PCH . DECK 

SUBROUTINE PUNCHV ( AP , J * L ,LCC ,CASE » 
C I MENS ICN AP ( 500 » A ) » T(5C0) 

RETURN 
; ; END 




$ I B F T C P AT 1 


DECK 


SUBROUT ITIE PARTI 



* 

CONTROL FOR 

BASIC DATA 

AND FORM 

MATRIX 


COMMON 

/ N6SAVE / NECL C, NIN 




COMMON 


HEDR (10) 

.CASE 

, NB 

' ,NNU 


1 


, FLG03 

, FLG04 

, FLG05 

,FLG06 

, FLG07 

2 


, FLG08 

,FLG09 

, FLG10 

, FLGl 1 

, FLGl 2 

3 


, FLGl 3 

, FLG 14 

, FLG 15 

,FLG16 

, FLGl 7 

4 


, FLG18 

, FLG19 

, FLG20 

,FLG21 

, FLG22 

5 


, FLG23 

,FLG24 

, FLG25 

, FLG26 

, FLG27 

DOUBLE 

PRECISION HEDR 

, CASE 




INTEGER 


FLG03 

, FLG04 

, FLG05 

, FLG06 

, FLG07 

1 


, FLG08 

, FLG09 

, FLGIO 

,FLG11 

, FLG12 

2 


,FLG13 

, FLG14 

, FLG15 

,FLG16 

» FLG17 

3 


, FLG18 

, F LG 19 . 

, FLG20 

,FLG21 

, FLG22 

4 


, FLG23 

, FLG24 

, FLG25 

, FLG26 

, FLG27 

common 


NT 

,NG< 11 ) 

• MN 

, NUNA ( 4 ) 

, TYPEA(4) 

1 


, NER1 

,NER2 

, NMA 

,NSIGA 

, NSIGC 

2 


, NUNC ( 4 ) 

,TYPEC (4 ) 

,NLF( 11) 



common 

I EC, 

NSIGEC, TYPEEC ( 4 ) , NUNEC(4) 



common 

/P/ 

IPUVEL 





REAL 


MN 





COMMON 

/CL/ 

XI (500), 

Yl(500), 

X2 ( 500 ) , 

Y2 ( 500 ) , 

DELS (500 ) , 

1 


SINA(5CC 

) , COSA ( 500 ) 

, XP ( 500 ) , 

YP ( 500 ) 


COMMON 

/TL/ 

TXK500) 

, TY 1( 500), 

NG(500), 

TG ( 500 ) , 

ALF A ( 500 ) , 

1 


RSDS ( 500 

), CALF (500) 

, SEQ1, 

SEQ2 , 

NSEQ, 

2 


CHORO, 

TEMP ( 600 ) 

, TCNST , 

DUMMY (4915) 

INTEGER 


BON 

, SUBKS 

, SEQ1 

, SEQ2 


REAL 


MX 

,MY 

,NG 




C 

c 

c 


* 
* 

NS£C=0 
100 READ (5,4) 
1 
2 
3 


C *** 

c*** 

c*** 


START 

READ INPUT CATA 

HEDR, CASE, SEQ1, NB, NNU 
FLG07, FLGC8, FLGC9, FLG10 , 

FLG15, FLG16, FLG17, FLG18 , 

FLG23, FLG24, FLG25, FLG26, 

MATRIX (SOLVIT) IS 


j ' i. v c. ^ u u c. -i i i kvi v « «- viu 

***TR I ANGULAR I Z AT ION OF THE MATRIX (S 
IF ( FLG09, EG .0 • AND.FLG10.EQ.O)FLG13=i 
***FLG22 IS GENERATED (RESEP) BOUND 


FLG03, FLG04, FLG05 , FLG06 
FLG12, FLGL3, FLGl 
FLG20 , FLG21, FLG2 
IPUVEL, NIN, SEQ2 
THE DEFAULT SOLUTI 


FLGl I , 
FLG19, 
FLG27, 


***FLG22 IS GENERATED (RESEP) 
***FLG21 IS EXTRA CROSS FLOW 
IF ( FLG22 . LE.O ) GO TO 5 
FLG21 = 1 
FLGO 3 = 1 
FLG04 = 1 


BOUNDARY CONDITIONS 


C*** *** IF FLAG 18 IS NOT EQUAL TO FLAG 14 YOU MUST USE DIRECT MATRIX 

5 IF ( FLGl 8 .NE.FLG14)GC TO 2 
IF (FLG2i.LE.0JG0 TO 3 
FLG12 = 1 
2 FLGl 3 = 1 
FLG09 = 0 
FLG10 = 0 



3 i CONTINUE 

: ' 1 F'( NBOLC .EG. 0 ) NBCLD = NB 

c*.** -♦■♦♦'CARDS (UNIT 5) ARE THE DEFAULT METHOD OF INPUT 
•V. ' IF ( NIN .EG. 0 ) NIN = 5 

'.AFCRMAT ( 10A6, 2X A6 , 8X 14/ 2811, 12, 46X, 14 } 

H IF (SEQ2.GE.SEQ1) GO TO 120 
t" ilC WRITE (6,6) 

6: FORMAT ( 1H0/38H DATA OUT OF SEQUENCE * SORT ON 77-80 ) 

TB'R ‘ 

,.V -12C SEC1=SEQ2 

■-V w . ; - REAO (5,8) CHORD, MN, TCNST , SEG2 
.8 FORMAT ( 3F10.0, 46X 14 ) 

- £**■*:■■* * *. T-H E DEFAULT CHORD LENGTH IS 1.0 

.y.; I F (CHORD. GT.-1.0E-5. ANC.CHORC.LT. 1.0E-5)CHORD = 1.0 


V- IF (SEQ2.LT.SEQ1) GO TC 110 
. SEQ 1=SEG2 


WRITE (6,12) HEDR , CASE, NB, NNU, CHORD, MN, TCNST 
12 FORMAT ( IH1 25X, 26HC0UGL AS AIRCRAFT COMPANY / 

1 28X , 21HL0NG BEACH DIVISION III ‘ 

'2. ' 6X , 4 3HPR0GR AM EODA — AXISYMMETRIC AND CROSSFLOW // 

■ ! 3 11X, 29HA**** CASE CONTROL DATA ***** III 

. .4 6X , 10A6, 4X , 1CHCASE NO. A6 // 

5 6X 9HB0DIES =13/ 6X 9HNNU =13/ 6X 9HCH0RD =F12. 

6 6X 9HMACH NC.=F12.8/ 6X 9HTCNST =F12.7/// ) 

IF (FLG03.GT.0) WRITE (6,16) 

16 FORMAT { 13X 21HSURFACE OF REVOLUTION ) 

IF (FLG04.GT.0) WRITE (6,20) 

20 FORMAT (13X 9HCR0SSFL0W ) 

IF ( FLG05.GT .0 ) WRITE (6,24) 

24 FORMAT (13X 15H0FF-B0CY POINTS ) 

IF ( FLG06.GT .0 ) WRITE (6,28) 

V 2 s 8ii FORMAT (13X 15HBASIC CATA ONLY ) 

' . ' I F ( FLG07 . G T . 0 ) WRITE (6,32) 

32 FORMAT (13X 17HELL IPS 6 GENERATOR ) 

IF (FLG08.GT.0) WRITE (6,36) 

; 36 FORMAT (13X 14HPRINT MATRICES ) 

. ..IF (FLG09.GT.0) WRITE (6,40) 

40 FORMAT (13X lOHOLO SEIDEL ) 


IF (FLG10.GT.0) WRITE (6,44) 

' 44 FORMAT ( 1 3X , 3 1HM0DI F I EC SEIDEL MATRIX SOLUTION) 

IF (FLG11.GT.0) WRITE (6,48) 

48 FORMAT (13X 18HPERTURBATI0NS ONLY ) 

.. IF .(F.LG12.GT.0) WRITE (6,52) 

52 FORMAT (13X 22HS0LVE POTENTIAL MATRIX ) 

IF ( FLG13.GT .0 ) WRITE (6,56) 

56- FORMAT (13X 47HMATRIX SOLUTION BY TR I ANGULAR I Z AT ION (SOLVIT)) 
, IF (FLG14.GT.0) WRITE (6,53) 

53 FORMAT ( 13X 30HPRESCR IB ED TANGENTIAL VELOCITY ) 

' IF HFLG18.GT.0) WRITE (6,69) 

691 FORMAT ( 15X 22HWITH SURFACE VORTICITY ) 

IF ( FLG15.GT .0 ) WRITE (6,54) 

54: FORMAT (13X 12HSTRIP VORTEX ) 

IF (FLG16.GT .0) WRITE (6,64) 

. 64 FORMAT (13X 40H0MIT AX I- SYMMETR IC UNIFORM FLOW SOLUTION ) 

IF (FLG17.GT.0) WRITE (6,68) 

68 FORMAT (13X 36HCMIT CROSSFLOW UNIFORM FLOW SOLUTION ) 



o 


IF (FLG19.GT.0) WRITE (6,72) 

72 FORMAT (13X 20HPRESCR I BED VORTICITY) 

IF (FLG20.GT.0) WRITE (6,78) 

78 FORMAT (13X 15HTOTAL VORTICITY ) 

IF ( FLG21 .GT.0)WRITE(6,77) 

* 77 FORMAT (13X 16HEXTRA CROSS FLOW) 

I F ( FLG22.GT .0 ) WRITE(6,81) 

81 FORMAT ( 13X 82HGENERATEC BOUNDARY CONDITIONS FOR 3 AX I SYMMETR I C , 1 
1CR0SS, AND 1 EXTRA CROSS FLOW.) 

IF (FLG19.GT.0) FLG18=1 

IF ( FLG22.GT .0.AND.NB.NE.2 ) GO TO 82 

GO TO 84 

82 WR I TE ( 6,83 ) 

83 FORMAT (128H0 WHEN GENERATED RESEP BOUNDARY CONDITIONS ARE USED,NU 
1MBER OF BODIES MUST BE EXACTLY TWO. YOU GOOFED. EXECUTION TERM 
2 INATING. ) 

STOP 

84 IF (FLG22.GT.O.AND.NNU.GT.OJGO TO 86 
GO TO 88 

86 WRITE (6,87) 

o e7 FORMAT (S8H0 GENERATEC RESEP BOUNDARY CONDITIONS CANNOT HAVE NON-U 

INI FORM FLOW INPUT. EXECUTION TERMINATING.) 

88 IF ( IPUVEL.NE.O)WRIT£ (6,73) 

73 FORMAT (13X 14HPUNCHEC OUTPUT) 

WRITE ( 6,75 ) NIN 

IF (FLG18.LE.O.OR.FLG14.GT.O) GO TO 125 
75 FORMAT ( 13X,58HINPUT TAPE NO. FOR COORDINATES AND NON-UNIFORM FLO 
1W ONLY « , 15 ) 

WRITE (6,70) 

70 FORMAT (1H0//63H FLG14 MUST BE USED WITH FLG18 OR FLGL9. EXECUTIO 
IN TERMINATED. ) 

STOP 

125 IF ( NNU.LE .0 .0R.FLG14.LE.0) GO TO 130 

WRITE (6,60) 0 

60 FORMAT (1H0// 49H COLUMNS 2 AND 14 OF FLAG CARD ARE BOTH NON-ZERO. 

A / 43H ILLEGAL COMBINATION. EXECUTION TERMINATED. ) 

STOP 

C * READ DATA AND SETUP FOR UNIFORM FLOW 

130 CALL BASIC1 

C*** ♦♦♦NS IGA AND NSIGC ULTIMATELY BECOME THE NUMBER OR RIGHT HAND SIDES 
C*** ♦♦♦IN AXISYMMETRIC FLOW ANO CROSS FLOW RESPECTIVELY 
133 NSIGA=0 

IF ( FLG03.GT .0.AND.FLG16.LE.0) NSIGA=1 
NSIGC-0 

IF ( FLG04.GT .0. AND .FLG 17 «LE. 0 ) NSIGC=1 
IF (FLG22.GT.0) GO TO 136 
DO 135 I « 1, 4 
NUN A ( I ) * 123456 

135 TYPEAU) = 100. 

GO TO 138 

€♦*♦ ♦♦♦PREPARE NUNA ANO TYPEA FOR NON-UNIFORM AXISYMMETRIC FLOW,GENER 
CXKM ♦♦♦(RESEP) BOUNDARY CONDITIONS 

136 00 137 I = 1,3 
NUN A ( I. ) ^ I 

137 TYPEA(I) = 100.0 

138 CONTINUE 


43 




C*** ***IF FLG02 ( NON— UNIFORM FLOW ) IS NOT CHECKED INITIALLY, THE FLOW * 
C*** #**OF CONTROL WILL NEVER REACH BASIC2 
IF ( NNU ) 140,150, 140 

C Q * READ DATA ANO SETUP FOR NON-UNIFORM FLOW 

14C CALL BASIC2 
150 IF ( NSEQ ) 160,160,110 
160 REWIND 4 

IF (NSIGA.LE.4) GO TO 180 < 0 • 

17C WRITE (6,74) 

74 FORMAT (1H1 75HAXI-SYH METRIC OR CROSSFLOW NON-UNIFORM FLOWS EXCEED 
A 4. EXECUTION TERMINATED ) 

STOP 

180 IF (NSIGC.GT.4) GO TG 170 

IF (FLG15.LE.0.0R.FLGC3.GT.0) GO TO 200 
WRITE (6,190) 

190 FORMAT (64H1STRIP RING VORTEX OPTION MUST USE SURFACE OF REVOLUTIO 
IN OPTION. / 22H EXECUTION TERMINATED. ) 

STOP 

2C0 IF (FLG15.LE.0) GO TO 230 
J * 0 

CO 210 I = 1, NB 
210 IF ( NLF( I ) .LE.O ) J=J*1 

IF (NSIGA+J.LE.4) GO TO 230 ' 

WRITE (6,220) 

220 FORMAT ( 6 8H1 GENE RATED STRIP VORTEX ONSET FLOWS (ONE FOR EACH LIFTI 
1NG BODY) PLUS / 34H INPUT NON-UNIFORM FLOWS EXCEED 4. / 

2 22H0EXECUTI ON TERMINATED. ) 

STOP 

230 IF (FLG06.NE.0) GO TO .100 
CALL MATRIX 
RETURN 
END 


;/ 



IIBFTC BAS I 


OECK, DEBUG 


C 

SUBROUTINE EASIC1 
C 

C * REAO DATA AND SETUP FOR UNIFORM FLOW 

C 

COMMON / NBSAVE / NBCLD, NIN 


COMMON 

HEOR( 10) 

,CASE 

, NB 

, NNU 


1 

, FLG03 

,FLGCA 

, FLG05 

,FLG06 

, FLG07 

2 

, FLG08 

» FLG09 

, FLG 10 

»FLG1 1 

, FLG12 

3 

, FLG1 3 

, FLG1A 

, FLG1 5 

,FLG16 

, FLG17 

A 

, FLG18 

,FLG19 

, FLG20 

,FLG21 

, FLG22 

5 

, FLG23 

, FLG2A 

, FLG25 

, FLG26 

, FLG27 

DOUBLE PRECISION HECR 

, CASE 




INTEGER 

FLG03 

, FLGOA 

, FLG05 

,FLG06 

, FLG07 

1 

, FLG08 

, FLG09 

,FLG10 

,FLGll 

,FLG12 

2 

, FLG1 3 

, FLG1A 

, FLG15 

, FLG16 

, FLG17 

3 

, FLG18 

, FLG19 

, FLG20 

, FLG21 

, FLG22 

A 

, FLG23 

r FLG2A 

, FLG25 

» FLG26 

, FLG27 

COMMON 

NT 

, NCI 11) 

, MN 

, NUN A ( A ) 

, T YPEA ( A) 

1 

,NER1 

, NER2 

,NMA 

, NS IGA 

, NS I GC 

2 

, NUNC ( A ) 

,TYPEC (A) 

,NLF( 11 ) 



COMMON IEC, 

NSIGEC, TYPEEC(A), NUNEC(A) 



DIMENSION COSSQR ( 500 ) , 

RHSI5C0) 




REAL 

MN 





common /CL/ 

XI ( 500 ) , 

Y1(5C0), 

X2( 500 ) , 

Y2I500), 

DELS ( 500 ) , 

1 

SINA(5CO),COSA( 500 ) 

,XP ( 500 ) , 

YP ( 500 ) 


COMMON /TL/ 

TXK500 ) 

, TYK 500), 

NGI500), 

TGI 500), 

ALFA ( 500 ) , 

1 

RSOS(50C ),CALF( 500) 

, SEQ1, 

SEQ2, 

NSEQ, 

2 

CHORD, 

TEMP ( 600 ) 

,TCNST , 

DUMMY! A915) 

INTEGER 

BON 

, SUBKS 

, SEQ 1 

, SEQ2 


REAL 

MX 

,MY 

, NG 




C 

C * START 

NT=C 
K=0 
K2=N8 

I F ( NIN .EQ. 0 ) NIN = 5 

IF (FLG05 .NE.O ) K2=N8+1 

C * MAJOR LOOP * NO. OF BODIES + OFF BODY POINTS 

CO 1000 U=1,K2 

REAO (5,15) NN, MX, MY, THETA, AODX, ADDY, SEQ2 

15 FORMAT ( 5X 15, 5F10.0, 16X IA) 

IF (SE02.LT. SEQ1) NSEC=1 

SEQ 1=SEQ2 

READ (5,16) BDN, SUBK S,NLF(L)»XE,YE, SEQ2 

16 FORMAT (3(5X,I5),2Fi0.0,26X IA) 

IF ( SEQ2.LT . SEQ1 ) NSEC=l 

SEQ 1 =SEQ2 

C*** ***NC(L) IS THE NUMBER OF POINTS ON BODY L, OR THE NUMBER OF OFF 


(.S' 


5 



c*** ***8CDY POINTS FOR L = NB + 1 
NO ( L )=NN 
M=NN-i 

IF (SUBKS) 140 * 150, 14G 
140 I F ( l .NE. K2 ) GO TO 148 

NTIMES = N80LD - NB 

I Ft NTIMES .LE. 0 ) GO TO 148 

00 145 NSKIPS = 1, NTIMES 
145 READ( 13) ( TX 1 ( I) , I = 1 ,NN ) , ( T Y1 ( I ) , 1 = 1 , NN > 

.148 READ( 13 1 ( TX 1 ( I ) , I = 1 , NN ) , ( T Y 1 < I > , I = 1 , NN ) 

GO TO 220 

150 IF (BON. EG. 0) GO TO 2C0 
IF ( FI.G07 ) 160,200,160 

C * ELLIPSE GENERATOR FOR XI AND Y1 

16C IF (XE.EQ.O.O) XE=1. 

IF (YE.EQ.O.O) YE=1. 

EN = M 

CGAM=3 .141593 /EN 
CAN =3. 141593 
CO 170 1=1, NN 
TX1 ( Ii>=XE*COS(GAM) 

TY1 ( IS=YE*SIN(GAM) 

170 GAM=GAM-OGAM 
GO TO 210 

C * READ XI ANC Y1 FROM INPUT CARDS 

200 CC 204 1=1, NN, 6 

REA0(NIN,20)TX1< I ),TX1(I-H ) , TX1 ( I * 2 ) , TX1 ( I +3 ) , TX1 ( I +4 ) , TX1 ( I +5 ) , 

1 SEQ2 

20 FORMAT ( 6F1C.0, 16X 14) 

IF ( SEQ2.LT . SEQ1 ) NSEC=1 
V 204 SEQ 1=SEQ2 

CO 206 1=1, NN, 6 

REA0(NIN»2C)TY1(I)»TY1( I + 1 )-, TY1 ( I * 2 ) , TY1 ( I +3 ) , TY1 ( 1+4 ) , TY1 ( I +5) , 

1 SEG2 

IF (SEQ2.LT. SEQ1) NSEC=1 
2C6 SEG1=SEQ2 

C * SAVE XI ANC Y 1 FOR SUBCASE 

210 ViR I TE (13) ( TXK I ), 1 = 1, NN) , (TYK I ) ,1 = 1, NN ) 

C * BASIC DATA CALC. AND PRINT (UNTRANSFORMED COORDINATES) 

. 220 WRITE (6,24) HEDR , NN, MX, MY, THETA, ADDX, ADDY, XE, YE 

24 FORMAT ( lHi 25X 26HCCUGLAS AIRCRAFT COMPANY / 

1 28X 21HLCNG BEACH DIVISION /// 5X 10A6 // 

2 8 X 4HNN = 14, 15X 4HMX = F13.7, 4X 4HMY = F13.7 / 

3 5X 7HTHETA = F13.7, 4X 6HADDX = F13.7, 2X 6HADDV =F13.7/ 

4 8X 4HXE = F13.7, 6X 4HYE = F13.7 ) 

IF (BON) 240,230,240 

230 WRITE (6,28) I I * TXKI), TY1II), 1=1, NN) 

28 FORMAT ( 1HC 4X 36HOFF-BODY COORDINATES (UNTRANSFORMED) // 

1 10X 5HX-0FF 9X 5HY-0FF // ( 1H 13, 2F14.7)) 

GO TO 270 
240 SUMS=0.0 

CO 250 1=1, M 
Tl = TXl( I41 ) — T X 1 ( I ) 

T2=TYl(I-tl)-TYl(I) 

X2( I )=ITX1( I+1)+TX1( I > )/2. 

Y2( I ) =(TY1(I+1)+TY1( I ) ) / 2. 




CELSm = SQRT(Tl*Tl*T2*T2) 

SUMS=SUMS+DELS(I) 

RSOS ( I )=SUMS 

250 ALFA ( I ) = ATAN2 ( T2, T1 ) 

MA=M-i 

CC 260 1*1, MA 

260 CALF(I) * ( ALFA( I+l )-ALFA( I) ) * 57.29578 

WRITE (6,36) B0N»TXl(l)»TYl(l)»X2(il#Y2(ll , OELS( 1) , RSOS ( 1 ) 

36 FORMAT ( 1H0 AX 35HON-80CY COORDINATES (UNTRANSFORMED) / 

1 9H BODY NO. 13// 11X 2H X 13X 1HY 11X 7HDELTA S 7X 

2 5HSUMDS 8X 7FC ALPHA // 1H 3H 1,2F1A.7 / AX APIA. 7) 
WRITE (6, AO ) (I, TXl(I), TYl(I), DALF(I-l), X2(l), Y2(I), 

1 DELS! I ) , RSDS(I), 1=2, M) , NN, TXl(NN), TYL(NN) 

AO FORMAT ( 1H 13, 2F1A.7, 28X F1A.7 / AX AF1A.7) 

C * ADJUST COORDINATES (TRANSFORMED) 

2>7C IF (MX) 2 80,300,280 
280 CO 290 1*1, NN 
290 TX1 ( I )=TX1( I )*MX 
3C0 IF (MY) 310,330,310 
310 CO 320 1*1, NN 
320 TY1 ( I ) =TY1 ( I )*MY 
330 IF (THETA) 3A0,360,3AC 
3A0 THETA = THETA / 57.29578 
| CSTHT = CCS ( THET A ) 

SNTHT = S IN( THETA ) ’ 

! CO 350 1*1, NN 
jf T1 = TX1 ( I ) 

1 TX1(IJ=T1*CSTHT+TY1(I)*SNTHT 
350 TY1 ( I ) *TY1( I ) *CSTHT— T 1 *$NTHT 
360 IF (ADDX) 370,390,370 
370 CC 380 1*1, NN 
38C TX1U)*TX1(I >+AOOX 
390 IF (ADDY) AO0,A20,A00 
ACO CO A10 1*1, NN 
AiC TY1 ( I ) *TY1 ( I ) + ADDY 

A20 IF (CHORD .EQ. 1.0 .OR. CHORD .EQ. 0.0 )G0 TO A50 
A30 CO AAO 1*1, NN 

TX1 ( I ) =TX1 ( I ) /CHORD 
AAO TY1(I)=TY1(I )/ CHORD 
A5C IF (MN) A60 , A75 , A60 
A60 SRM=SQRT< l.-MN*MN) 

CC A70 1*1, NN 
A7C| TX1(I)=TX1(I)/SRM 

C * SHIFT XI ANC Y1 TO COMMON /CL/ 

C*«* 44*IF BDN = 0.0, OFF 8CCY POINTS ARE BEING OPERATED ON 
A75 IF (BON) 500,A80»500 
ABO CO A90 1*1, NN 
XP ( I ) = TX1 ( I ) 

A90 YP ( I ) = TY1 ( I ) 

WRITE (12) (XP( I ),I=1,NN), (YP( I ), 1=1, NN ) 

GO TO 1000 
500 CC 510 1*1, NN 
K=K + 1 

XI ( K )=TX1 ( I ) ^ 

51C Y1 ( K ) =TY1 ( I ) 

NT=NT+M 


67 



IOCO CONTINUE 

REWIND 13 5 

IF (FLG14.LE.0) GO TO 20C0 «- 

IF (FLG14.LE.NB) GO TC 1050 
WRITE (6,1025) 

1025 FORK AT (45H1VALUE OF FLG14 EXCEEDS NO. OF BODIES. STOP., ) 

STOP ^ 

1050 IF (FLG14.NE.NB) GO TC 1C75 

NM A = 0 v 

GO TO 1150 . 

1075 L = NB-FLG14 
NMA = -L 

CO 1100 I = 1, L 

C*** *<*NMA BECOMES THE NUMBER OF ELEMENTS ON THE 1ST L BODIES (IE THOSE 
C*** M*NCT HAVING AN INPUT VORTICITY OR VELOCITY) 

11C0 NMA = NMA + ND ( I ) 

C*** *«*NR BECOMES THE NUMBER OF ELEMENTS RECEIVING AN INPUT VORTICITY 
C*** *<*GR VELOCITY 
1150 NR = NT-NMA 

IF (TCNST.GT.O. ) GO TO 2CC0 
CO 1200 I = 1 , NR , 6 

READ (5,20) TG C I ) ,TG< I + l ) , TG ( I *2 ) , TG ( l+3>,TG(I+4) ,TG( 1 + 5) ,SEQ2 
IF (SEQ2.LT. SEQ1) NSEC=1 
1200 SEQ1=SEQ2 

C * CALC. PARAMETERS WITH TRANSFORMED COORDINATES AND 

C MACH NC. ADJUSTMENT 

20CC M-0 
Ji=0 

CO 2500 K= 1 , NB 
Mi=Nl+l 
N’l = N 1 + ND f K )- 1 
0 CO 2400 J = N 1 » N 1 
Jl=Jl*i 

T1=X1< Jlfl )-Xi( Jl) w 

T2 = YH Jl + 1 J-Y1CJ1) 

X2( J)~<X1( J1+1J+XKJ1) )/2. 

Y2(J)-(Yl(Jl + l)+Yl(Jl))/2. v. 

DELS(J) = SQRT( Tl*Tl+T 2*T2 ) 

CCSA(J)=T1/DELS( J) 

2400 SINA(J)=T2/DELSVj) 

2500 Ji = JH-l 

C * SAVE PARAMETERS 

WRITE (12) ( Xlfl ) ,1=1, Jl ), (Yl( I ) ,1 = 1, Jl), (X2(I ) , 1=1, NT) 

1 , (Y2( I ), 1=1, NT ), (DELS( I ) » I = 1, NT ) 

REWIND 12 

C * SAVE SINA AND CCSA ON TAPE 4 FOR CALC. OF MATRIX 

C SOLUTION (RIGHT HAND MATRIX) 

WRITE (4) (SINA(I),I=l,NT),(COSA(I),I=l,NT) 

IF ( FLG14) 2600,2600,2550 0 

2550 IF (TCNST.GT.O.G) WRITE(4) ( TCNST , 1=1 ,NR ) 

IF (TCNST. LE. 0. ) WRITE(4) (TG(I), 1=1, NR) 

2600 IF (FLG22.LE.0) RETURN a 
N'PB 1 =* NOfl) - 1 
CC 2700 I = l.NPBl 
CGSSQUm = COSA ( I)**2 V 

2700 RHSIII = 2.0 * ABS( SINA(I) * COSA(I) ) 

WRITE (4) ( COSSQR(I) , l=l,NPBl) , (RHS(I),I = l.NPBl) 

RETURN 

END 



h n m sr »n csj m -<r 


SIBFTC BAS2 


DECK 


C 

C 

C 

C 


C 


C 

C 

C 


SUBROUTINE BASIC2 


* READ DATA AND SETUP FOR NON-UNIFORM FLOWS j 


COMMON 

/ NBSAVE / N8CL0, NIN 




COMMON 

HEDR( 10) 

, C ASE 

,NB 

,NNU 



, FLG03 

, FLGO A 

, FLG05 

, FLG06 

, FLG0.7 
,FLG12 


, FLG08 

, FLG09 

,FLG10 

,FLG11 


, FLG13 

, FLG1A 

, FLG15 

,FLG16 

,FLG1»7 


, FLG18 

,FLG19 

, FLG20 

, FLG2 1 

, FLG22 


, FLG23 

, FLG2 A 

, FLG25 

, FLG26 

, FLG27 

DOUBLE 

PRECISION HEDR 

, CASE 



I 

INTEGER 

FLG03 

, FLGO A 

, FLG05 

,FLG06 

, FLG0i7 


, FLG08 

, FLG09 

, FLG10 

,FLG1 1 

, FLGlv? 


, FLG13 

, FLG1A 

, FLG15 

, FLG16 

, FLG1 7 


, FLG18 

, FLG 19 

, FLG20 

, FLG 2 1 

, FLG22 


, FLG23 

, FLG2 A 

, FLG25 

,FLG26 

,FLG27 

COMMON 

NT 

,NC< 11 > 

, MN 

, NUNA ( A ) 

, TYPEA (A) 


»NER1 

, NER2 

, NM A 

, NS IGA 

, NS I GC 


, NUNC ( A ) 

,TYPEC (A) 

y NLF ( 11) 



COMMON 

I EC , NSIGEC, TYPEEC(A), NUNEC(A) 



REAL 

MN 





COMMON 

/CL/ X 1 ( 500 ) , 

Y1(5C0), 

X2( 500 ) , 

Y2 ( 500 ) , 

DELS ( 500 ) , 


S I N A ( 5 00 ) , COS A ( 500 ) 

»XP< 500) , 

YP (500 ) 


COMMON 

/TL/ TXK500) 

, TYH500), 

NG( 500 ) , 

TG ( 500 ) , 

ALFA( 500) , 


RSDS1500 ),CALF(500) 

, SEQ1, 

SEQ2, 

NSEQ, 


CHORO, 

TEMP (600) 

, TCNST , 

DUMMY ( 4915 ) 

INTEGER 

BON 

, S EQ1 

, SEG2 



REAL 

MX 

, M Y 

»NG 




* START 

* SETS OF NGN-UM FORM FLOW LOOP 
NSIGEC = 0 

KA = 0 
KC=0 
KEC = 0 

I F | NIN .EC. 0 ) NIN « 5 

CO 1000 L = 1 , NNU 

REAC 15,20) NUN, MSF, TYPE, FG, SEQ2 
20 FORMAT ( 2(5X 15), 2F10.0, 36X 14 ) 

IF (SEQ2.LT. SEQ1) NSEC=1 
SEQ1=SEC2 

IF (MSF.EG.1.QR.MSF.EC.2.0R.MSF.EQ.5) GO TO 30 

KAsKA+1 

NSIGA=NSIGA+l 

KUNA (KA)=NUN 

TYPEA( KA ) =TYPE 

3C IF (MSF.EQ.0.0R.MSF.EC.2.0R.MSF.EQ.4) GO TO 35 


1 


KC=KC+1 
NS I GC=NS IGC+ 1 
v NUNC ( KC ) =?NUN 
^ TYPEC( KC ) =TYPE 

35 t IF (MSF.LT.2.0R.MSF.EC.3 ) GO TO 40 
KEC = KEC +1 
NSIGEC = NSIGEC + 1 
I MINEC ( KEC ) = NUN 
3 TYPEEC (KEC ) = TYPE 
AO IF (TYPE) 50,70,70 
C * COMPUTED TYPE 

5 §0 DC 60 1 = 1, NT 
¥ NG ( I )=Y2 ( I ) 

60 TG ( I )=FG-X2( I ) 

GC TO 110 

C * ( X , Y ) OR <N,T) TYPE * READ INPUT 

70 DC 90 1 = 1, NT, 6 

READ(NIN,80)NG(I),NG(I + 1),NG(I+2)»NG< 1+3 ) , NG< I+A ) , NG( I +5 ) , SEQ2 
80 FORMAT ( 6F10.0, 16X IA) 

IF (SEQ2.LT.SEQ1) NSEC=1 
90 SEG1=SEG2 

CO 100 I=?1,NT,6 

READ(NIN,80)TG( I),TG( 1 + 1 ) , TG ( I +2 ) , TG ( I + 3 ) , TG ( I+A ) , TG ( 1 + 5 ) , SEQ2 
IF (SEQ2.LT. SEQ1) NSEC=1 
ICC $EQ1=SEQ2 
110 IF (TYPE) 120, 1A0, 120 
120 CO 130 I * 1, NT 
* T1=NG( I ) 

i. NG(I)= T1*S INA ( I )-TG ( I )*COSA { I ) 

130 TG( I )= Tl+COSA < I ) +TG ( I )*SINA ( I ) 

C f. * WRITE BASIC DATA OUTPUT 

1A0 WRITE (6,150) HEDR ,MSF , T YPE, FG ,NUN , ( NG( I ) , I =1 ,NT ) 

150 FORMAT < 1H1 25X 26H0CUGLAS AIRCRAFT COMPANY / 

° \ 1 28X , 21HL0NG BEACH DIVISION /// 5X 10A6 // 

i 2 6X 5HMSF = IA, 10X 6HTYPE = F10.A, 10X AHFG = F13.7 / 

3 1H0 , AX, 20H NON-UNI FORM FLOW NO. 16 / 

A 1H0, AX, 10HLIST OF NG// ( 1H 6F1A.7)) 

,T WRITE (6,160) (TG(I), I = 1, NT) 

1^60 FORMAT (1H0 AX 10HLIST OF TG // ( 1H 6F1A.7)) 

| WRITE (A) MSF,(NG( I) , I=1,NT)»(TG( I ), 1=1, NT) 

1000 CONTINUE 
RETURN 
END 


10 



I 


u 


IIBFTC MATRX 

CECK t DEBUG 





C 

r 

SUBROUTINE MATRIX 





c 

r 


* COMPUTE MATRIX A,8,Z 

OR X , Y, Z 



t 

COMMON 

HEOR(IO) 

, CAS E 

»NB 

,NNU 



1 

,FLG03 

, FLG04 

, FLG05 

, FLG06 

»FLG07 


2 

t FLG08 

, FLG09 

, FLG10 

,FLG1 1 

, FLG12 


3 

, FLG13 

, FLG14 

t FLG15 

, FLG16 

, FLG17 


A 

, FLG18 

, FLG 19 

, FLG20 

, FLG2 1 

, FLG22 


5 

,FLG23 

, FLG24 

, FLG25 

, FLG26 

, FLG27 


ccueiE 

PRECISION HE0R 

, CASE 





INTEGER 

FLG03 

, F LG04 

, FLG05 

»FLG06 

, FLG07 


1 

t FLG08 

, FLG09 

, FLG10 

,FLGil 

,FLG12 


2 

t FLG1 3 

, FLG 14 

t FLG 15 

, FLG16 

,FLG17 


3 

• FLG18 

, FLG 19 

, FLG20 

,FLG21 

, FLG22 


4 

> FLG23 

, FLG24 

, FLG25 

,FLG26 

, FLG27 


common 

NT 

, NC( 11) 

t MN 

, NUN A ( 4 ) 

,TYPEA(4) 


1 

» NER1 

»NER2 

, NMA 

, NS IGA 

» NSIGC 


2 

, NUNC ( 4 ) 

,TYPEC(4) 

,NLF( 11 ) 




COMMON 

IEC » NSIGEC, TYPEECI4), NUNEC ( 4 ) 




REAL 

MN 





c 

LOGICAL 

PF 





COMMON 

/ECF/ ECX ( 500 ) > 

ECYI500), 

ECZI500) 




common 

/CL/ XII 500 ) » 

Yl(500), 

X2I500), 

Y2 ( 500 ) » 

DELS (500), 


1 

SINAI5CC 

) ,C0SA(500 

) » XP 1 500 ) , 

YP (500 ) 



COMMON 

/TL/ A( 500 ) , 

B( 500 ) , 

AX (500), 

AY ( 500 ) , 

AZ ( 500 ) , 


1 

CX ( 500 ) f 

CY( 500), 

CZC500), 

AXV ( 500 ) , 

AYV ( 500 ) , 


2 

VN( 500,4 

) ,VT(5C0,4 

) , BON, 

YZERO, 

I AC, 


3 

I, 

J, 

Jl, 

SJ, 

DS, 


4 

OX, 

CY, 

N I , 

XJ, 

YJ, 


5 

XK, 

EEK , 

EKK, 

K, 

PF 


C 

C * START 

C ♦ INITIALIZE 

L1=NT 
8GN=0.0 
YZERCMO.O 


C *+* 

♦♦♦TEST TYPE OF FLOW ANC SET INDICATORS I 

AC 

AND 

IEC 


C«MM 

♦♦♦CROSS FLOW ONLY 

I AC 

= 

-1 

IEC = 

-1 

C«*« 

♦♦♦AXISYMMETRIC FLOW ONLY 

I AC 

= 

♦ 1 

IEC = 

-1 

C.«** 

♦♦♦EXTRA CROSS FLOW ONLY 

I AC 


0 

IEC = 

0 

c *** 

♦♦♦CROSS FLOW AND AXISYMMETRIC FLOW 

I AC 


0 

IEC = 

-1 

C4*4 

♦♦♦CROSS FLOW AND EXTRA CROSS FLOWW 

I AC 

= 

-1 

IEC = 

+ 1 

c *** 

♦♦♦AXISYMMETRIC AND EXTRA CROSS FLOW 

I AC 


+ 1 

IEC = 

+ 1 

C *** 

♦♦♦AXISYMMETRIC, CROSS, AND EXTRA CROSS 

I AC=0 

IEC = 

+ 1 


IF(FLG03)30, 10,30 
10 IF ( FLG04I 25, 15*25 
15 I AC = 0 


- 7 / 


o 



o no 


I 


IEC = 0 
GG TO 55 
25 I AC = -1 
GG TO 45 

30 IF(F LG 04)35,40*35 
35 I AC = 0 
GG TO 45 
40 IAC = 1 

45 IF(FLG21)50,53 f 50 
50 IEC = +1 
GG TO 55 
53 IEC = -1 
55 ASSIGN 110 TO K1 

IF (FLG15.GT.0) ASSIGN 102 TG K1 
■ .60 CO 6 5 I- *1, LI t 

DC 65 J ? 1, NB 
VN( I,J> =; 0. 

65 VT ( I , J ) n 0. 

C * I MIDPOINT LOOP 

CO 400 1*1, LI 

* J ELEMENT LOOP 

J1 IS THE COORDINATE COUNTER 
J IS THE ELEMENT COUNTER . 

Ji=0 

N1=C O i 

CC 110 K* 1 » NB 

M1=N1>1 X) 

N1=N1*NDCK )-l 
CO 100 J-M1.N1 
J1=J1*1 

PF = FLG18.GT.0.AN0. J.GT.NMA.0R.FLG20.GT.0 
C * COMPUTE X , V , Z MATRICES 

CALL XYZ 
ICO CONTINUE 

GO TO Kl, (102,110) 

102 IF (NLF(K).GT.O) GO TC 110 
IF (BON. EC. 0. ) GO TO 105 
CC 103 J = Ml, N 1 

VN ( I , K ) * VN( I,K)4AXV( J) 

103 VT(I,K) = VT ( I ,K )+AYV ( J ) 

GG TO 110 

1C5 CC 106 J = Ml, N1 

VN ( I , K ) = VN ( I , K ) *AXV( J )*SINA( I ) - A YV ( J ) *COS A ( I ) 

106 VT(I,K) * VT ( I , K ) +AXV(J)*COSA(I) *■ AYV ( J ) *S INA ( I ) 

110 J1=J1*1 

IF (BON) 120,210,120 

C * SAVE X , Y, Z GN TAPE *OFF BODY POINTS 

C*** ***S AVE X , Y , Z ON TAPE * OFF BODY POINTS 

C*,** *** AX I SYM METR IC FLOW * TAPE 9 

C*** ***CROSG FLOW * TAPE 10 

C * ***EXTR A CROSS FLGW * TAPE 8 
120 IF ( IEC.EQ.-l )G0 TO 125 

122 WR I TE ( 8) ( ECX ( J ) , J=1 ,NT ) , ( EC Y ( J ) , J= 1 , NT ) , ( ECZ ( J ) , J = 1 , NT J 
IF (IEC) 125,400,125 
125 IF ( IAC) 140,130,130 

130 WRITE (9) (AX(J),J=1,NT),(AY(J),J=1,NT),(AZ(J),J=1,NT) 


7 ^ 



IF ( I AC ) 400,140,400 

140 WRITE’ ( 10 I (C X( J ) , J=l ,NT ) »( CY ( J I , J=1 , NT) , (CZ( J ) , J-l, NT I 
GO TO 400 

CO,** ***SAVE CN TAPE * ON BODY 
C*** ***AXISYNMETRIC FLOW * TAPE 9 

> c*** ***CROSS FLOW * TAPE 10 

C*** ***EXTR A CROSS FLOW * TAPE 8 
C*.** *** IEC = -1 MEANS NO EXTRA CROSS FLOW 

210 IF (IEC. EG. -1) GO TO 240 
22C CC 230 J = 1 , NT 

A ( J ) = -ECX(J) * S IN A ( I ) + E,CY ( J ) * COSA( I) 

230 BUI = ECX(J) * CGSA(I) + ECY(J) * SINA(I) 

WRITE (81 ( A ( J ) , J=l, NT ) , ( 8 ( J > , J= l , NT ) , ( ECZ( J ) , J=1»NT) 
IF ( IEC I 240,400,240 
240 IF ( I AC I 310,250,250 
250 GO 260 J= 1 ,NT 

A ( J ) =—AXt J)*SINA( I ) + AY(J)*COSA( I I 
260 0( J)=AX( J)*COSA( I )+AY ( J)*SINA( I I 

WRITE (9) (A(J) , J=1 , NT I, (B(J ) , J = 1 , NT I, (AZ(J) ,J = 1»NT) 

270 IF ( I AC ) 400,310,400 
310 CO 320 J=i 1 , NT 

A(J)=-CX(J)*SINA( I l+CY ( J )*COSA ( I I 
320 B( J)=CX( J )*COSA( I ) +C Y ( J ) *S INA ( I ) 

WRITE (10) (A(J),J=1,NT),(B(J),J=1,NT),(CZ(J),J=1,NT> 
400 CONTINUE 

IF (FLG15.LE.0) GO TO 1400 
IF (BON.NE.O.J GO TO 1200 
C*** *«*0N BOCY 
READ (4) 

IF (NNU.LE.O) GG TO 600 
CO 500 I = 1, NNU 

REAC (4) MSF»(A(J),J=1,NT) , (R(J),J=1,NT) 

500 WRITE (3) MSF, (A(J),J=1,NT), (B(J) ,J=l,NT) 

REWIND 3 
REWIND 4 
READ (4) 

600 N-NS IGA-1 

IF (FLG16.GT.1) N=NS IGA 

C*** *«*N = 0 MEANS 1 RHS ONLY NO NON-UNIFORM FLOW 
IF (N.EC.OI GO TO 800 
CC 700 I = 1, N 

REAC (3) MSF,(A(J),J*l,NT),(B(J),J=l,NT> 

TOO WR I TE( 4 I M$F,(A(J),J=1,NT),(8(J),J=1,NT) 

8CC M=0 

CO 900 J = 1, NB 
IF (NLF(J).GT.O) GO TC 900 
NS IC- A=NS IG A+ 1 
N NU=NNU+1 

WRITE (4) M,(VN(I,J) , 1 = 1 ,NT I , ( VTI I , J I , I =1, NT I 
9CC CONTINUE 
M*NS IGC-1 

IF (FLG17.GT.0) M=NSICC 
IF (M.LE.O) GC TO HOC 
CO 1000 I = 1, M 

READ (3) MSF,(A(J)»J=1*NT),(B(J)»J=1»NT) 

1000 WRITE (41 MSF,(A(J),J=1,NT), ( B ( J ) , J= l , NT ) 


73 



n n 


o ■ 


UOO REWIND 3 

GG TO 1400 
C*.** «**OFF BODY 
1200 CO 1300 J = 1, NB 

IF (NLF(J).GT.O) GO TC 1300 

WRITEI4) (VNCI.J), I = 1»L1), (VT(I,J»tI = 1,L1) 
1300 CONTINUE 

* TEST IF OFF BODY COMPLETED 

* TEST IF OFF BODY 

1400 IF (FLGO5.EQ.0.OR.BON.NE.0. ) GO TO 1600 
C * INITIAL FOR OFF BODY * THEN RE-ENTER I 

BGN= 1 • 

Ll=NO( NB+1 ) • 

CO 1500 I = 1, LI 
X2(I) = XPIII 
1500 Y2( I i = YP( I I 
GO TO 60 
1600 REWIND 9 
REWIND 8 
REWIND 10 
REWIND 4 
RETURN 
EKO 


\ 




t 


J LOOPS 


0 



tlBFTC XYZ 


CECK, DEBUG 


C 

SUBROUTINE XYZ 
C 


c 

r 

* CONTROL FGR X f Y ,Z MATRICES COMPUTATION 

V 

u 

CCNMON 1 HEDRUO) 

, CASE 

, NB 

, NNU 


1 , FLG03 

, FLGOA 

, FLG05 

, FLG06 


2 , FLG08 

, FLG09 

, FLG10 

,FLG1 1 


3 , FLG13 

, FLG1 A 

, FLG15 

,FLG16 


A , FLG18 

,FLG19 

, FLG20 

, FLG2 1 


5 , FLG23 

, FLG2A 

, FLG25 

, FLG26 

0 

DOUBLE PRECISION HECR , CASE 



INTEGER FLG03 

, FLGOA 

, FLG05 

, FLG06 


1 ,FLG08 

, F LGC9 

, FLG10 

, FLGl 1 


2 , FLG13 

, FLG1 A 

, FLG15 

, FLG16 


3 , FLG1 8 

, FLG1 9 

, FLG20 

♦FLG21 


A ,FLG23 

, FLG2A 

, FLG25 

, FLG26 


CCPPON NT 

»NC( 11 ) 

, MN 

, NUN A ( A ) 

u 

I , NER1 

,NER2 

, NHA 

,NS IGA 

2 t NUNC ( A ) 

, TYPEC (A ) 

, NLF ( 1 1 ) 



C CP NON IEC, NSIGEC, TYPEEC ( A ) , NUNEC(A) 


c 

0 

REAL MN 

LOGICAL PF 




CC'P PON /CL/ XI (500) 

, YK5G0), 

X2 ( 500 ) , 

Y2 ( 500 )-', 


I S I N A ( 500 ) , COSA ( 500 ) 

, XP ( 500 ) , 

YP ( 500 ) 

6 

COMMON /TL/ A ( 500 ) , 

8(500), 

AX ( 500 ) , 

AY ( 500 ) , 


1 CX( 500 ) 

, CY ( 5C0 ) , 

CZI500) , 

AXV ( 500 ) 


2 VN ( 500 , 

A),VT(5C0,A) 

, BON, 

YZERO, 


3 I, 

J, 

Jl, 

SJ, 


A DX, 

CY, 

NI, 

XJ, 

r 

5 u XK, 

EEK, 

EKK , 

K, 

L 

c 

* START 





IF (BON) 100,10,100 





10 IF (J-I) 110,20,110 




c 

* J EQUAL I 

PATH 




20 Tl=.5*DELS(J) 





SJ=T1/Y2I J ) 

IF ( SJ-.08 ) 30, 30, AO 

• 




30 CALL XYZl 





GC TO 1000 


* 



AO $J=.08 . 





vv • wv 

CALL XYZl 
N I = 3 3 

T2=«08*Y2 ( J ) 

CS= ( TI-T2 ) /32. 
CX=DS*COSA(J) 

0Y=CS*SIN A ( J ) 

XJ=X2( JHT2*CGSA( J)-DX 


IS 


, FLG07 
, FLG12 
» FLG17 
»FLG22 
, FLG27 

, FLG07 
» FLG12 
• FLG17 
• FLG22 
» FLG27 
,TYPEA(A) 
, NS I GC 


‘ ^DELSI 500) , 

AZ ( 500 ) , 
t AYV ( 500 ) » 

I AC» 

OS, 

YJ, 

PF . 


o 



o r> on 


0 


YJ=Y2C J»4T2*SINA( JJ-CY 

CALL XYZ2 'j 

GO TO 300 

C * INITIAL Y COORDINATE MID-POINT FOR ZERO TEST 

ICO YZER0=Y2( I >-.000001 

* J NOT EQUAL I PATH 

' * COMPUTE MINIMUM DISTANCE TO I MIDPOINT 

HO 01=(X2m-XICJl) )**2*(Y2(I l-YKJll )**2 
C2=( X2<I)-X2< J) ) **2* ( Y2 ( I )-Y2( J ) )**2 
C3=(X2( I »-Xl(Jl+in**2+CY2(I l-YKJl + l) )**2 
IF (G1-C2) 1 30 » 130, 12C 
120 IF ( D2-03 ) 1 50 » 150, I AC 
130 IF ( Dl-03 ) 160 , 160 , 1 AC 
I AO CM= SQRT ( 03 ) 

GO TO 170 
150 CM=SQRT(D2) 

GG TO 170 
160 CM=S0RT(D1) 

* COMPUTE NO. OF INTERVALS! NI ) AND DELTA S (DS) 
FOR SIMPSON RULE INTEGRATION 

170 IF (DM.EQ.O.Q) GO TO 200 
NI=8.*DELS< J )/DM+0.9 
IF (NX) 180,180,190 
180 NI=3 

GS-OELSI J )/2. 

GO TO 220 

190 NI=NI+NI , 

IF { NX— 128 ) 210,200,200 
2CC N I = 1 29 

CS=DELS( J)/128. 

C-0 TO 220 
210 XNI=N I 

CS=DELS( J )/XNI 
NI=NI+l 

220 CX=CS+COSA(J) 

CY=DS*SINA ( J ) 

3CC XJ=X1(J11-CX 
Y J= Y l ( Jl I — CY 
CALL XYZ2 
IOCO RETURN 
END 



$IBFTC XYZ1 


DECK, DEBUG 


C 

SUBROUTINE XYZ1 
C 

C * COMPUTE X,Y,Z MATRICES FOR SJ LESS THAN OR EQUAL .08 

C 


COMMON 

HEDR( 10) 

,CASE 


, NB 

,NNU 


1 0 

, FLG03 

, FLGOA 


, FLG05 

,FLG06 

, FLG07 

2 

t FLG08 

,FLG09 


, FLG 10 

,FLG11 

,FLG12 

3 

, FLG1 3 

,FLG1A 


, FLG15 

,FLG16 

, FLG17 

A 

, FLG18 

, FLG19 


, FLG20 

,FLG21 

, FLG22 • 

5 

, FLG23 

, FLG2A 


, FLG25 

, FLG26 

, FLG27 

DOUBLE 

PRECISION HEDR, CASE 





INTEGER 

FLG03 

, FLGOA 


, FLG05 

, FLG06 

, FLG07 

1 

, FLG08 

, FLG09 


, FLG10 

,FLG11 

, FLG12 

2 

, FLG13 

,FLG1A 


, FLG15 

»FLG16 

, FLG17 

3 

, FLG18 

, FLG19 


, FLG20 

,FLG21 

, FLG22 

4 

, FLG23 

, FLG2A 


, FLG25 

,FLG26 

, FLG27 

COMMON 

NT 

,NC( 11 ) 


, MN 

,NUNA( A) 

, TYPEA( A 

1 

, NER 1 

,NER2 


,NMA 

,NSIGA 

, NSIGC 

2 

, NUNC ( A ) 

, T YPEC ( A ) 


• NLF( 11 ) 



COMMON 

IEC, NSIGEC, TYPEEC(A), 

NUNEC ( A ) 



COMMON 

/ECF/ ECX( 500 ) 

, ECY ( 5C0 ) 

9 

ECZ ( 500 > 



REAL 

MN 






LOGICAL 

PF 






COMMON 

/CL/ XI ( 500 ) 

, Yl(500) 

9 

X2 ( 500 ) , 

Y2 ( 500 ) , 

DELS( 500) 

1 

SINA(500)»COSA(500) 

,XP ( 500) , 

YP(500) 


COMMON 

/TL/ A (500), 

° B( 500 ) , 


AX ( 500 ) , 

AY ( 500 ) , 

AZ ( 500 ) , 

1 

CX ( 500 ) 

, CY ( 5C0 ) 

9 

CZ( 500 ) , 

AXV ( 500 ) 

, AYV ( 500 ) , 

2 

VN( 500 , 

A ) ,VT(5C0, 

4) 

, BON , 

YZERO , 

I AC, 

3 . 

c I, 

Jt 


Jit 

SJ, 

OS, 

A 

DX, 

CY, 


NI, 

XJ, 

YJ, 

5 

XK, 

EEK , 


EKK, 

K, 

PF 


C 

C * START 

C * INITIALIZE 

T1=SJ*SJ 
T2=AL0G( S J/8 • ) 

T3=SINA(J)*StNA(J) 

T4-T2+T3 

T5=. 6666667 *T3 

T6=T5*T3 
T7=S J+S J 
T8-T7+T7 

T9=6. 283185 *CCSA( J ) 

T10=6. 283185 *SINA(J> 

T11=T1*S J 

T1A = .3332333 * (16. C ♦ 6.0 * T3) + 2.0 * T2 
IF (IEC.EC.-l) GO TO 15 

C.4** ***EXTRA CROSS FLOW 1ST TERM OF X(I,I), YU, I), Z(I,I> 


t 


« 

10 ECX(J) = 6.283185 * ‘SINAIJ) + 2.0 * SINA(J) * COSA(J) * SJ 
ECY(J| =-6.283185 * CCSA(J) ♦ SJ * T1A 
ECZ ( J ) = -8.0 * <1.666667 ♦ T2 > * SJ 
IF < IEC) 15,1000,15 
15 IF(PF) GC TO 25 , 

IF (IAC) 30,20,20 
C * AXIS FLOW 

20 AX( J)=T10+SINA<J)*C0$A(J)*<T7+(T4+2. 166667 )*TU/12.) 

AY< JI=T7*TA-T9-( 1.+T2-T3-T6 )*Tll/8. 

T12=T1+T1 . 

AZ< J)=Y2< J)*T8*<1.-T2+T1*<2.-T12+3.*T2*<1.+T12))/14A. ) 

25 IF (IAC) 30,30,100 
C * CROSS FLOW 

30 T13=T1/16. 

CXI J)=T10+2.*SINA< J) *SJ*COSA( J)*( 1.-T13*! 3.-T5+T 2+T2) > 
CY(J)=-T9+T7*<2.+T4*T13+(1. -A. 777778 *T3+T6+T2*< 3.-2.666667 * 

1 T 3 ) ) ) 

CZ( J)=-T8*<1. + T2-TI3*( 1.11 11 11 *T3+T2* < T5-1 . ) ) ) 

ICO IF (PF) GC TO 200 

IF IFLG15.LE.O.OR.NLF IK) .GT.C) GO TO 1000 
200 AXV < J ) = T9+T7*IT2-T3>+Tll*(T2*(12.*T3-9.) 

1 -9. ♦ 23.*T3 - 6.*T3*T3) / 72. 

AYV(J) = T 10 ♦ 2.*COSA< J)*SINA( J ) *< SJ-T 11* I 6 ,*T2+9.-2. *T3 ) /48. ) 
IF ( • NOT . PF ) GO TO 1000 
AX ( J ) = AXV(J) 

AY ( J ) = AYV(J) 

1000 RETURN 
END 


7 ? 


6 _ 



$ IBFTC XYZ2 DEBUG, OECK 

C 

SUBROUTINE XYZ2 
C 

C * COMPUTE X , Y , Z MATRICES USING SIMPSON RULE INTEGRATION 

C 


COMMON 

HEDRI 10) 

,C ASE 

,NB 

, NNU 


1 

, FLG03 

, FLG04 

, FLG05 

,FLG06 

,FL V G07 

2 

» FLG08 

, F LG09 

, FLG 10 

, FLG1 1 

, FLG1 2 

3 

, FLG1 3 

, FLG I 4 

, FLG15 

, FLG 16 

,FLG17 

4 

, FLG18 

, FLG19 

, FLG20 

,FLG21 

, FLG22 

5 

, FLG23 

, FLG 2 4 

, FLG25 

, FLG26 

, FLG27 

DOUBLE 

PRECISION HEDR , CASE 




INTEGER 

FLG03 

, FLG04 

, FLG05 

, FLG06 

, FLG07 

1 

, FLG08 

, FLG09 

, FLG10 

, FLG 1 1 

, FLG12 

2 

, FLG13 

,FLG14 

,FLG15 

,FLG16 

, FLG17 

3 

, FLG18 

, FLG19 

, FLG20 

, FLG2 1 

, FLG22 

4 

, FLG23 

, FLG24 

» FLG25 

, FLG26 

, FLG27 

COMMON 

NT 

,NC( 11 ) 

(, MN 

, NUNA I 4 ) 

, TYPE A I 4 ) 

1 

, NER1 

, NER2 

,NMA 

» NS I G A 

, NSIGC 

2 

, NUNC ( 4 ) 

, TYPEC (4 ) 

,NLF( 11) 



COMMON 

IEC , NSIGEC, TYPE EC (4), 

NUNECI4) 



COMMON 

/ECF/ ECX ( 500 ) 

, ECYI5C0) 

, ECZI500) 



real 

MN 


0 

J 


LOGICAL 

PF 




COMMON 

/CL/ XI ( 500 ) 

, YK500I 

, X2I500), 

Y2I500) , 

DELS! 500) , 

1 

SINAI 500 ), COS A (500) ,XP(500), 

°YP I 500 ) 


COMMON 

/TL/ A ( 500 ) , 

BI500), 

AX I 500 ) , 

AY ( 500 ) , 

AZI500) , 

1 

CXI 500 ) 

, CYI5C0) 

, CZI500), 

AXVI500) 

, AYV I 500 ) , 

2 

VNI 500, 

4) ,VT(5C0, 

4), BON, 

YZERO, 

I AC , 

3 

I> 

J, 

Jl* 

SJ, 

DS, 

4 

DX, 

CY, 

NI, 

XJ, 

YJ, 

5 

XK, 

EEK , 

EKK , 

K, 

PF 


C 

C * START 

C * INITIALIZE 

DEBUG NI » I ,DX , DY, YJ, X 2 C I ) » X J » Y2 ( I ) 

ASSIGN 570 TO K1 

IF ( FLG15 .LE.O.CR.NLF(K).GT.C) GO TO 15° 

10 ASSIGN 420 TO K1 

15 S2=. 6666667 *0S 0 0 

SI = .3333333 * OS v 

53 = 8. 0/3.0 * SI 
S5 = .3333333 * SI 

54 = S2+S2 

T1 = Y2( I )*Y2I I ) 

ASSIGN 28 TC K2 
ASSIGN 410 TO K3 
ASSIGN 570 TO K4 
IF (oNOT.PF) GO TC 16 

? 


”7 9 



‘ 

5 


ASSIGN 110 TO K2 
ASSIGN 420 TO K3 
ASSIGN 560 TO K4 

C * NO. OF INTERVAL LOOP 

16 CO 1000 I S = 1 » NI 
X J=X J+DX 

YJ=YJ+DY , 

T2= Y J*YJ 
T3=X2( I >-XJ 
T 4=T3*T3 

T5= ( Y2 ( I)+YJ)**2 

T6=T4+T5 

T7=SQRT(T6) 

T8=T2+T4 

IF(T8.EC.0. ) T 8 = 1 . E- 6 
T9*(Y2( I)-YJ)**2 
T10=T9+T4 

T21 = SORT ( T 1 / T8 ) 

C * COMPUTE ELL IP IC INTEGRAL 



XK = 

4.*YJ*Y2< I )/T6 



CALL ELIP 



IF 

( I EC ) 18,575, 

18 

18 

IF 

( I AC ) 200,20,20 




• * AXIS FLOW 

20 

Til 

= YJ/T7 



IF 

( T21.LT. 0.01) 

GO TO 24 


T12 

= YJ/Y2 ( I ) 



FV2 

= <EKK+EEK*(Tl 

-T81/T101/T7 


FV3 

= Y2CI1/T10 * 

T3/T7 * EEK 


FI 

= FV3*T12 



F2 

= FV2*T 12 



FV4 = FV2*T3/Y2 ( I) 

F3=Tll*EKK 
GO TO 26 
2 A FV2 =0. 

FV3 = 0. 

FV4 = 0. 

C*** ***SMALL Y FORMULAS AXISYMMETRIC FLOW 
T23 = T1 / T 8**2 
T24 « 2.0 * T4 - T2 

FI = < ( 1.570796 * YJ * T3 ) / ( T8**l.5 ) 

1 ( 1.0 4 ( .75 * ( 3.0 * T2 - 2.0 * T4 1 * T23 ) 1 
F2 = ( 1.570796 * YJ * Y2 (I) 1 * ( T24 / (T8**2.5 

F3 = 1.570796 * YJ * ( 1.0+ (.25 * T23 * 1-T24) ) ) 
26 CONTINUE 

GO TO K2 , ( 28 , 1 10 1 

C * SIMPSON RULE INTEGRATION 

28 IF (IS-11 30,30,40 
C * FIRST PASS 

30 AXS=F1 
AYS=F2 
AZS=F3 
IA=0 

GO TO 110 

40 IF (IS-NI) 50,80,50 
5C IF (IA) 70,60,70 


* 


) ) 

/ SORT ( T8 1 


20 



c 


7C 


8C 

90 


ICO 


no 


c 

200 


c*** 

220 


C 

230 

C 

240 


250 

260 

C 

270 


C 


* EVEN PASS 
AXS=AXS*4.*F1 
AYS=AYS+4.*F2 
AZS=AZS+4.*F3 

I A=1 

GO TO 110 

* CCD PASS 
AXS=AXS+F1+F 1 
AYS=AYS+F2+F2 
AZS=AZS+F3+F3 

I A=0 

GO TO no 

* LAST PASS 
IF (J-I) 100,90,100 

IF (BON. NE. 0.0) GC TO 100 
AX(J)=AX(J)-S4*(AXS+F1 ) 

AY( J)=AY( J)-S2*(AYS+F2 ) 

AZ( J)=AZ( J)+S4*( AZS+F3 ) 

GO TO no 

AX( J)=-S4*(AXS+F1> 

AY( J)=-S2*(AYS+F2) 

AZ(J) s S4*(AZS+F3) 

IF ( I AC ) 200,200,400 

* CROSS FLOW 

IF (T21.LT. 0.04) GC TC 220 
T12 * T 1 + T 8 

F1-T3/ Y2( I )*(EKK-EEK*T12/T10)/T7 
F2=(EEK*(T8*T8+T1*(T4-T2))/T10-EKK*T8)/T1/T7 
F3=T7*(EKK*T12/T6-EEK )/Tl 
GO TO 230 

***SMALL Y FORMULAS * CROSS FLOW 
T23 * T1 / T 8**2 

T29 * ( 1.570796 * T2 ) / ( T8**1.5 > 

T26 = 4.0 * T4 - T2 
T31 = T26 * T23 

FI = ( (-4.712389) * T2 * T3 * Y2(I) ) / ( T8**2.5 
F2 = T29 * ( 1.0 - (1.125 * T31 ) ) 

F3 = T29 * ( 1.0 - (.375 * T31) ) 

* SIMPSON RULE INTEGRATION 
IF (IS-11 240,240,250 

* FIRST PASS 

CXS=F1 

CYS=F2 

CZS=F3 

IC = 0 • 

GO TC) 400 

IF ( IS-NI ) 260,290,260 
IF (1C) 280,270,280 

* EVEN PASS 
CXS=CXS+4.*F1 
CYS=CYS*4.*F2 
CZS=CZS+4.*F3 

IC=1 

GO TO 400 

* OCD PASS 


280 CXS=CXS+F 1+F 1 



CYS=CYS+F2+F2 

CZS=CZS+F3+F3 

IC=0 

GC TO 400 

C * LAST PASS 

290 IF (J-I) 310 » 300 » 310 
300 IF (BON.NE.O.O) GO TO 310 
CX( J)=CX( J)+S2*(CXS+F1) 

CY(J)=CY(J)+S2*(CYS+F2) 

CZ( J)=CZ( J)+S2*(CZS+F3) 

GC TO 400 

310 CX(J)'=S2*(CXS + F1) 

CYC JI=S2*(CYS+F2) 

CZ< J)=S2*(CZS+F3) 

400 GO TO K3, (410,420) 

410 GC TO Kl, (570,420) 

C*** ***FLOW OF CONTROL REACFES HERE FOR ( PF=TRUE ) OR ( 
C * * * ***NLF LE 0 (LIFTING BCCY)) AND ( I NE J ON BODY OR 
420 FV1 = (T2-T1J/T7 * EEK/T10 
IF ( IS.GT.l) GO TC 440 
C * FIRST PASS 

AX1 = FV1 
AX2 = FV2 
AY 1 = FV3 
AY2 = FV4 
IV=0 

GC TO 570 

440 IF (IS.EQ.NI) GO TO 5C0 
IF (IV) 460,450,460 
C * EVEN PASS 

450 AX 1 = AX1 + 4.*FV1 
AX2 = AX2 +4 . *FV2 
AY1 = AY1 +4 . *FV3 
AY2 = AY2+4 • *FV4 
IV=1 

GO TO 570 

C * OCD PASS ■ 

460 AX 1 = AX1 + FV1 + FV1 
AX2 = AX2+FV2+FV2 
AY1 = AY1 +FV3+FV3 
AY2 = AY2+FV4+FV4 
IV = 0 
GO TQ 570 

C * LAST PASS 

500 IF (J-I) 540,520,540 
520 IF ( BCN.NE .0 . ) GO TO 540 

AXV(J) = AXV(J) - S4* ( AX1+FV 1 ) - S2*(AX2+FV2) 
AYVCJ) * AYV(J) - S4* ( AY 1+FV 3 ) + S2*(AY2+FV4) 

GO TO 550 

540 AXV(J) = -$4* ( AX 1 + FV 1 ) -S2* ( AX2+FV2 ) 

AYV(J) = -S4*( AY1 + FV3 ) + S2* ( A Y2 + FV4 ) 

550 GC TO K4, (560,570) 

C4* * ***FLOW OF CONTROL REACHES HERE IF PF IS TRUE 
560 AX ( J ) = AXV(J) 

AYCJI = AYV(J) 

570 IF (IEC.EQ.-l) GO TO 1000 


( FLG15 GT 0 AND 
ANY OFF BODY) ) 



575 IF (T2I.LT. 0.08JG0 TG 595 
580 T20 = SORT ( T2 / (T1 ♦ T4) ) 

IF (T20.LT.0.01) GO TC 590 
T13 = YJ * Y2(I ) **3 

T14 * T1 ♦ T8 

T15 = T2 * II 

T 16 = T14 * T l A 
T 1 7 = T1 ♦ YJ 

T 18 = T1 * T1 

T19 = T8 * T8 

F 3 = ( T7/T13 ) * ( ( - T 1 4 ) * EEK ♦ ( ( (T16 - T15> * 
FI =(T3 / ( T 1 7 * T 7 ) ) * ( (EEK / T10 ) * (T16 - 3 0 ■ 
1 (T14 ♦ EKK) ) 

TEMPI =( (-8.0*T8**3) - ( 12 . 0*T 1 *T 19 ) ♦ ( ?6.0*T 15*T8 ) 
l ♦ < 2.0*T18*( 2.0*T1 -5.0*T2) ))* EEK/HO 
TEMP2 = EKK * ( <8.0*T19) ♦ (4.0*T1*T8) - (2.0*T15) - 
F2 = (TEMPI ♦ TEMP2) / ( T13 * T7) 

CC TO 630 

C*** * * * SMALL YJ FORMULAS * EXTRA CROSS FLOW 

590 T25 = Y J * * 3 
T 30 = T 4 + ' T 1 
T2 7 = T30**3 . 5 
T 28 = T25 * Y 2 ( 1 ) 

FI = ( 2.995243 * T25 * T3 * T 1 » / T27 

F 2 = 7.068584 * T2E * ( 3.0 * T1 - 2.0 * T4 ) / 

F? = 1.747146 * T28 /(T3C**2.5 j 

GO TO 630 

C*** ** ♦ SMALL V FORMULAS * EXTRA CROSS FLOW 

595 T25 = Y J* *3 

FI = ( 2.945243 * T 2 5 * T 3 ♦ T 1 ) / ( T8**3.5 

F2 = ( (-14.13717) * T25 * Y2(I) > / (T8**2.5) 

F 3 = -F2 / 8.0 
C*** ***SIMPSCN*S RULE 

630 (F (IS - 1) 640,640,650 
C*** ■■♦♦FIRST PASS 
640 EC X S = FI 

EC Y S = F2 . 

ECZS = F3 
IE ■ = 0 

GO TO 1000 

650 IF (IS - M) 660,690,660 
660 IF ( IE ) 680,670,680 
C*** ’> * ♦ EVEN PASS 

670 EC X S = ECXS .♦ 4.0 ♦ FI 
EC YS = EC Y S ♦ 4.0 ♦ F2 
ECZS = ECZS ♦ 4.0 * F 3 
IE = l 
GC TO 1000 
C*** •♦♦ODD PASS 

680 ECXS = ECXS ♦ FI + F 1 
E 3YS = EC YS ' ♦ F2 + F2 
ECZS = ECZS ♦ F3 ♦ F3 
IE = 0 
GO TO 1000 
C*** ♦♦♦LAST PASS 

69C I F ( J - I) 710,700,710 
C*** ***I=J * ELEMENTS ON MAIN DIAGONAL 

7C0 IF (BON. NE. 0.0) GO TC 710 

ECX(J) = ECX(J) -S4 * ( ECXS ♦ FI ) 

ECY(J) = ECYIJ) — S5 • * ( EC YS ♦ F2 ) 

ECZ(J) = ECZ(J) ♦ S 3 * ( ECZS ♦ F3 ) 

CC TO 1000 

c*** ♦♦♦OFF MAIN DIAGONAL CR OFF BODY POINTS 
TIC ECX(J) ? -S4 * ( ECXS * FI ) . 

EC Y ( J ) = -S5 * ( ECYS .♦ E2 ). 

ECZ(J) = S3 * ( ECZS ♦ F3 ) 

10C0 CCNTINUE 
RETURN 
END 

% 3 


EKK) / T6 ) ) 
T15) - 

( 4 .0*T 18 ) ) 

T 27 
> 



$ I B F T C FLIP 


CECK 


C 

SUBROUTINE ELIP 
C 

C * HASTINGS APPROXIMATION FOR ELLIPTIC INTERGALS 

C 


COMMON 


HEDR(IO) 

»C ASE 


,NB 

, NNU 


I 


, FLG03 

, FLGOA 


, FLG05 

, FLGC6 

, FLG07 

2 


, FLG08 

, FLG09 


.FLG10 

»FLG1 1 

,FLG12 

3 


, FLG13 

, FLGIA 


, FLG15 

, FLG16 

, FLG17 

A 


, FLG18 

, FLG19 


, FLG20 

,FLG21 

, FLG22 

5 


, FLG23 

, FLG2A 


, FLG25 

, FLG26 

t FLG27 

COUeLE 

PRECISION HECR , CASE 





INTEGER 


FLG03 

, FLGOA 


, FLG05 * 

, FLG06 

, FLG07 

1 


, FLG08 

, FLG09 


, FLGIO 

,FLG11 

, FLG1 2 

2 


» FLGI3 

, FLGIA 


, FLG 15 

,FLG16 

t FLG17 

3 


, FLG18 

, FLG19 


, FLG20 

,FLG2 1 

, FLG22 

A 


, FLG23 

, FLG2A 


, FLG25 

,FLG26 

» FLG27 

COMMON 


NT 

, NCI ID 


,MN 

,NUNA ( A ) 

, TYPEA (A) 

1 


, NER1 

, NER2 


, NMA 

, NS IGA 

, NSIGC 

2 


,NUNC( A) 

, T YPEC ( 4 ) 


, NLF ( 11) 



COMMON 

IEC , 

NSIGEC, TYPEEC(A), 

NUNEC(A) 



REAL 


MN 






LOGICAL 

PF 







COMMON 

/CL/ 

Xl( 500 ) 

, Y1(5C0) 

f 

X2 ( 500 ) , 

Y2 ( 500 ) , 

OELS ( 500 ) , 

1 


S I NA ( 500 ),COSA(50Q) 

,XP( 500) , 

YP ( 500 ) 


COMMON 

/TL/ 

A( 500 ) , 

8(500), 


AX ( 500 ) , 

AY ( 500 ) , 

AZ ( 500 ) , 

1 


CX ( 500 ) 

, CY ( 500 ) 

f 

CZ ( 500 ) , 

AXV ( 500 ) 

, AYV ( 500 ) , 

2 


VN ( 500 , 

A ) , VT ( 5C0 , 

A) 

, BON , 

YZERO, 

I AC, 

3 


I, 

J f 


Jit 

SJ, 

DS, 

A 


DX, 

CY, 


N I , 

XJ, 

YJ, 

5 


XK, 

EEK, 


EKK, 

K, 

PF 


C 

C * START 

ETA = 1. - XK 
IF I ETA) 20, 20, AO 
20 WRITE (6,30 ) ETA 

30 FORMAT ( 1H1 36H *** ERROR IN SUBROUTINE ELIP * ET A= F15.8 ) 

WR I TE ( 6 » 800 ) I,XJ,DX,YJ,DY,X2( I),Y2(I),XK 
8C0 FORMAT ( 1H ,I5,7FI5.6) 

ETA = 0.0C0CO5 
AO ELN=ALOG( ETA ) 

EKK = 1.38629AE0 4 ETA * (.9666344E-1 + ETA * 

1 (.3590092E-1 4 ETA * (.3742564E-1 4 ETA * 

2 .1A51I96E-I ))) - ELN * (.5 4 ETA * (.1249859E0 4 

3 ETA * U68802A9E-1 4 ETA * (.3328355E-1 4 ETA * 

A .AA17870E-2 > > > » 

EEK = 1. 4 ETA * (.4432514E0 4 ETA * (.6260601E-I 4 ETA * 

1 (.4757384E-1 4 ETA * .1736506E-I ))) - ELN * (ETA * 

2 ( . 2A99837E0 4 ETA * ( .9200180E-1 4 ETA * 

3 ( . A069698E-1 4 ETA * .526A496E-2 )))) 

RETURN 

END 



JIfi.FTC PAT2 


DECK 


SUBROUTINE PART2 
C 

C * COMPUTE SOURCE DENSITY SIGMA BY SIEDEL ITERATION 


COMMON 


HEDR(IO) 

.CASE 

,NB 

.NNU 


1 


, FLG03 

• FLGOA 

, FLG05 

.FLG06 

. FLG07 

2 


» FLG08 

, FLG09 

, FLG10 

,FLGII 

,FLG12 

3 


* FLG13 

.FLG1A 

, FLG15 

.FLG16 

, FLG17 

A 


> FLGI8 

» FLG19 

, FLG20 

.FLG2I 

, FLG22 

5 


> FLG23 

. FLG2A 

, FLG25 

.FLG26 

, FLG27 

DOUBLE 

PRECISION HECR 

, CASE 




INTEGER 

FLG03 

.FLGOA 

, FLG05 

.FLG06 

, FLG07 

1 


, FLG08 

, FLG09 

, FLG10 

, FLG11 

,FLG12 

2 


, FLG13 

, FLG1 A 

,FLG15 

,FLG16 

, FLGI7 

3 


, FLG18 

, FLG19 

, FLG20 

. FLG21 

, FLG22 

A 


> FLG2 3 

, FLG2A 

, FLG25 

. FLG26 

, FLG27 

COMMON 


NT 

, NC( 11 > 

,MN 

.NONA ( A ) 

,TYPEA(A) 

I 


» NERI 

,NER2 

, NMA 

. NSIGA 

. NSIGC 

2 


, NUNC( A ) 

,TYPEC (A ) , NL F ( 1 1 ) 



COMMON 

IEC , 

NSIGEC, TYPEEC(A) 

, NUNEC(A) 



REAL 


MN 





COMMON 

/C2/ 

A( 500) , 

R( 50C 

, A ) , NSIG, 

IT 


DIMENSION 

AS IG ( 500 

t A ), 

C S I G ( 500 , A ) , 

T ( 500 ) 


C * START 

IP (FLG03.EQ.0) GO TC 1CCO 
C * AXIS FLOW 

L=0 . . 

READ (A) (T(I), 1=1, NT) 

IF (FLG16.NE.0) GO TC 20(3 
l s L*l 

CO 100 I = 1, NT 
ICG R(I,L) = TII) 

2CG IF (NNU) 600,600,300 
3C0 CO 500 J = 1, NNU 

C * READ NON-UNIFORM NO * SKIP TO 

READ (A) MS , (T ( I ) , I- 1 ,NT ) 

IF (MS.EQ.il GO TO 5QC 
L = L+1 

CO AOO I = 1, NT 
ACC R(I,L) = T ( I » 

500 CONTINUE 
600 REWIND A 
IT = 9 

NSIG = NS IGA 

C * SOLVE SIMULTANEOUS EQUATIONS FOR SIGMAS 

CALL MISNA2 (ASIG) 

REWIND 9 

IF (FLGOA.GT.O) GO TC 10CO 
C * WRITE SIGMAS ON TAPE 3 

CO 700 J * l, NS IGA 
7C0 WRITE (31 ( ASIGI I , J) , I = 1, NT) 


85 " 


RETURN 


C * CROSS FLOW 

10C0 L = 0 c 

READ (A) (T(I), 1=1, NT), ITU), 1 = 1, NT) 

IF (FLG17.NE.0) GO TO 1200 
L = L + l •' • 

CO 1100 I = 1, NT 
1100 R( I, LI = -T( IJ 
1200 IF (NNU) 1600,1600,1300 
13CC CC 1500 J =1, NNU 

READ (4) MS , ( T C,I ) » 1= 1 » NT ) 

IF (MS.LE.O) GO TC 1500 
L = L+l r ■ 

CC 1400 I =/ 1, NT 
14C0 R ( I , L ) = T ( I j 
1500 CONTINUE ; 

16CG REWIND 4 
IT = 10 

. NSIG = NSIGC . 

C ■’ * SOLVE SIMULTANEOUS EQUATIONS FOR SIGMAS 

CALL MI SNA 2 (CSIG) 

REWIND 10 ’ . 

IF (FLG03.LE.0) GO TO 1675 
C * WRITE SIGMAS ON TAPE 3 

CC 1650 J = 1, NSIGA 
1650 WRITE (3) ( AS IG ( I , J ) , I = 1 ,NT ) 

1675 CO 1700 J = 1, NSIGC „ 

17C0 WRITE (3) ( C S I G ( I,J) ,1=1, NT) 

RETURN 

END 



$ IBFTC MISN 


DECK 


SUBROUTINE MISNA2 (SIG) 

C 

C * SOLVE LINEAR SIMULTANEOUS EQUATIONS BY SET DEL ITERATION 


COMMON 

HEDR(IO) 

, CASE 

, NB 

, NNU 


1 

, FLG03 

, FLGC4 

, FLG05 

,FLG06 

,FLG07 

2 

, FLG08 

, FLG09 

, FLG 10 

,FLG1 I 

, FLG1 2 

3 

, FLG13 

, FLG14 

, FLG15 

,FLG16 

, FLG17 

A 

, FLG 18 

, FLG19 

, FLG20 

,FLG21 

,FLG22 

5 

, FLG23 

, FLG24 

, FLG25 

,FLG26 

, FLG27 

COUBLE 

PRECISION HEDR 

, CASE 




INTEGER 

FLG03 

, FLG04. 

, FLG05 

,FLG06 

,FLG07 

1 

,FLG08 • 

, FLG09 

, FLG 10 

, FLG1 1 

,FLG12 

2 

,FLG13 

, FLG14 

, FLG15 

,FLG16 

, FLG17 

3 

, FLG1 8 

, FLG19 

, FLG20 

, FLG2 1 

,FLG22 

4 

, FLG23 

, FLG24 

, FLG25 

, FLG 2 6 

, FLG27 

COMMON 

NT 

,NC( 11 ) 

, MN 

,NUNA ( 4 ) 

, TYPEA (4) 

1 

, NER1 

, NER2 

, NMA 

,NS IGA 

,NSIGC 

2 

,NUNC(4) 

, T YPEC ( 4 ) 

,NLF( 11) 



REAL 

MN 






COMMON /CZ/ A( 500 ) » R(500,4), NSIG, IT 

C 

DIMENSION SIG(500,4), KFLAG (4 ) , DSIGH4), DSIG(500,4) 
C 

C * START 

C * INITIALIZE 

10 NTU=0 
I TER=0 
NC0NV=0 

CC> 20 J=1,NSIG 
KFLAGI J) =0 
CC 20 1=1, NT 
20 SIG( I, J)=G.G 
30 CC 35 1=1, NSIG 
35 GSIGK I)=0.0 

C * COMPUTE SIGMA AND DELTA SIGMA 

CC 300 Ini »NT 
IF I NT U— 3 ) 40,100,110. 

40 IF (FLG12.NE.G) GO TC 60 
C * PLACE A IN LEFT SIDE MATRIX 

IF (IT. EG. 10) GO TO 5G 
REAO (9) ( A ( L ) , L=1 , NT ) 

GO TO 80 

50 READ (10) (A(L),L=1,NT) 

GO TO 80 

* PLACE PHI IN LEFT SIDE MATRIX 
60 IF (IT.EQ.10) GO TO 70 

READ (9) (AIL),L=1,NT),(A(L),L=1,NT) , ( A ( L) ,L=1,NT) 


C 



C-0 TO 80 

70 READ (10) (A(L),L=l,NT) t (A(L),L=l f NT) f 4A(L).L*l,NT) 

C * SAVE LEFT SIDE MATRIX 

80 WRITE (3) (AIL) *L=1» NT I 
WRITE (II) (A(L),L=1,KT) 

GO TO 200 

C * READ LEFT SIDE MATRIX 

ICO READ (3) (A(L)»L=1»NT) 

GO TO 200 

110 READ (11) ( A ( L ) » L= l» NT ) 

200 00 300 Jnl »NSIG ... 

IF (KFLAG ( J ) .NE.O ) GO TO 3Q0 

SUM=0.0 

CO 210 L=;1,NT 

210 SUM=SUM+A ( L I *S IG ( L » J ) ' 

CS I G ( 1 » J ) = ( R (.1 # J ) -SUM ) / A ( I ) 

IF (FLG09.NE.0)' GO TO 220 ; 

SIG(I, J)~SIG(I,J)+DSIG(I,J) 

220 IF (ABS(DSIGdtJ) ).GT.DSIG1( J) ) DSIG1 ( J ) = ABS(DSIG( I , J) ) 

300 CONTINUE 

IF (FLG09.LE.0) GO TO 320 
CO 310 J = 1 »NSIG 

CC 310 m,NT . 

310 S IG ( I » J I^S IG ( I , J )+DS I G ( I , J ) 

C * TEST FOR SOLUTION 

320 REWIND 3 
REWIND 11 
I TEP= I TER + 1 . 

CO 400 J=1,NSIG 

IF ( KFLAG ( J) .NE.O) GO TO 400 

IF (DSIG1 ( J) .GE. l.E-6 ) GO TO 400 

KFLAG( J ) =5 1 TER 

NC0NV=NCCNV+1 

IF ( NCCNV .EQ.NSIG) GO TO 600 
400 CONTINUE 

IF ( ITER. EC. 100) GO TO 600 
IF ( NTU.EC.3) GO TO 500 

N T U = 3 \ 

GO TO 30 
500 N T U = 1 1 
GO TO 30 

C * PRINT NO. CF ITERATIONS 

600 CO 800 J=1,NSIG 

IF (KFLAG( J) .NE.O) GC TO 700 
WRITE (6,610) 

610 FORMAT (1H0 7X 36H NO CONVERGENCE AFTER 100 ITERATIONS ) 

GO TO 800 

TOO WRITE (6,710) KFLAG(J) 

710 FORMAT ( 1H0 5X 15, IX 36H ITERATIONS REQUIRED FOR CONVERGENCE ) 
800 CONTINUE 
RETURN 
END 



CECK 


$ IB F T C PRE P 

SUBROUTINE PREP 

C ** * PREPARE TAPES 3 AND 11 FOR USE BY LINK 5 (MATSOL) 

CC MM ON /SPACER/ WKAREA( 16000) 

CIMENSICN TEMPI 50 A ) , V 2 < 50C > 


CCMMON 

HEDR( 10) 

, C AS E 

• NB 

, NNU 


1 

, FLGO 3 

, FLGO A 

, FLG05 

,FLG06 

, FLG07 

2 

, FLG08 

, FLG09 

, FLG10 

,FLG 1 1 

, FLG 1 2 

3 

, FLG13 

, FLG1A 

, FLG 1 5 

»FLG16 

,FLG17 

A 

, FLG1 8 

, FLG19 

, FLG20 

, FLG 21 

, FLG22 

5 

, FLG23 

, FLG2 A 

, FLG25 

,FLG26 

, FLG27 

CCUBLE PRECISION HE DR 

, CASE 




INTEGER 

FLG03 

, FLGGA 

, FLG05 

, FLG06 

, FLGO 7 

1 

, FLG08 

, FLG09 

, FLG10 

, FLG11 

, FLG1 2 

2 

, FLG13 

, FLG1 A 

, FLG1 5 

,FLG16 

, FLG1 7 

3 

, FLG18 

, FLG19 

, FLG20 

,FLG21 

, FLG2 2 

A 

, FLG23 

, FLG2 A 

, FLG25 

,FLG26 

, FLG27 

COMMON 

NT . 

,NC( 11) 

,MN 

,NUNA( A) 

, TYPE A ( A ) 

1 

, NER 1 

,NER2 

, NMA 

, NSIGA 

, NS IGC 

2 

, NUNC ( A ) 

, T YPEC ( A ) 

»NLF (11) 



CCMMON IEC 

, NSIGEC, TYPEEC ( A ) , NUNEC(A) 



REAL 

MN 





DIMENSION 

COSSQR ( 500 ) , 

RHSC 500) 




C I MENS ICN 

A ( 50A ) , R ( 500 

, A ) , FF ( 500 ) 

, T ( 500 ) 




DATA F0URPI/12.56637C6/ 

C*** ♦♦♦AXISYMMETRIC FLOW ONLY MS = 0 

C*+* ♦♦♦CROSS FLOW ONLY MS = 1 

C%** ♦♦♦EXTRA CROSS FLOW CNLY MS = 2 

C*** ♦♦♦AXISYMMETRIC AND CROSS FLOW MS * 3 

C*** ♦♦♦AXISYMMETRIC ANO EXTRA CROSS FLOW MS = A 

C*** ♦♦♦CROSS AND EXTRA CROSS FLOW MS = 5 

C*'M ♦♦*AXISYMMETRIC»CROSS» AND EXTRA CROSS FLOW MS = 6 

IF(FLG12.EQ.O.OR.(FLGOA.EQ.O.AND.FLG21.EQ.O) ) GO TO 3 
IF ( FLG05 . EQ .0 ) GG TC A 
C*** ♦♦♦SKIP CFF BODY COORDINATES 
REA0I12) 

A NI=NT+NB 

REACI12) ( TEMPI I ) » I = 1 , NI ) , ( TEMP ( I ) , I = 1,NI), 

1 ( TEMP ( I I , I = 1 , NT ) , ( Y2 ( I ) , I = 1,NT) 

REWIND 12 
3 REWIND 3 

IF (FLG03) 5,800,5 

C ♦♦ ♦ PREPARE AXISYMMETRIC MATRIX TAPE C3) 

5 IF (FLG19.GT.0) GO TG 20CO 
IF ( FLG22.GT.O) GO TC 255 
K = 0 

L = NT+NSIGA 

READ (A) (All), 1=1, NT), IFF (I), 1=1, NT) 

IF (FLG16.NE.0) GO TC 20 
K = K+l 

CC 10 I =f 1, NT 
10 RU,K) = All) 

20 IF ( NNU ) 60,60,30 

30 CC 50 J = 1, NNU . • 

RE AO (A) MS, (A(I) ,1=1, NT) 





IF (MS.EQ.1.0R.MS.EQ.2.0R.MS.EC.5) GO TO 50 
K = K+I 

CG 40 I = 1, NT 
40 R(ItK) = All) 

. 50 CONTINUE 

60 IF (FLG14.LE.0) GO TO 290 
NR= NMA+1 

READ (4) ( R ( 1 , 1 ) , I-NR »NT) 

REWIND 4 

CO 220 I = NR, NT 
220 R< I , I) = R( 1 ,1 1 - FF ( I ) 

IF (FLG14.EQ.NB) GO TC 245 
CO 240 1=1, NMA 
READ (9) ( A( J ) , J=1 ,NT ) 

A { NT + 1 ) =; R( 1 , 1 ) 

240 WRITE (3) ( A ( J ) , J = 1 , L ) 

245 CO 250 I = NR, NT 

READ (9) (A(J)»J=1»NT),(A(J),J=1,NT) 

A ( NT+1 ) * R ( I , 1 ) 

250 WRITE (3) (A(J),J=1,L> 

C PRESCRIBED TANGENTIAL VELOCITY INPUT TO SOLVIT ON TAPE 3 

C OUTPUT FROM SOLVIT ON TAPE 3 

C TAPES 1 AND 2 ARE SCRATCH TAPES 

CALL SOLV IT ( WKAREA,NT ,NS IGA, 16000, 3, 1,2* 3, +9010) 

REWIND 9 
GO TO 800 

C*** ***AXl SYMMETRIC FLOW * GENERATED (RESEPJ BOUNDARY CONDITIONS 

C**<! ***NPB1 = THE NUMBER OF ELEMENTS ON BODY 1 

C*** ***NPB2 = THE NUMBER OF ELEMENTS ON BODY 2 

255 NPB 1 = ND(1> - 1 
NPB2 = NO ( 2 ) - 1 
NSIGA =3 
NSIGC = l 
NSIGEC =1 
L = NT ♦ NSIGA 

C,*** ***L IS THE TOTAL WICTH OF THE MATRIX FOR AXISYMMETRIC FLOW INCL 

C*** ***R I GHT HAND SIDES 

READ (4) 

REAO ( 4 ) I COSSQR ( I ) » I = 1,NPB1), (RHS(I),I = l.NPBl ) 

REWIND 4 

CO 260 I = l.NPBl 
R< 1,1) = 0.0 
R ( I , 2 ) = 1.0 
260 R( I ,3) = COSSQR I I ) 

NBEGIN = NPB1 +1 
NEND = NPB1 ♦ NPB2 
CO 265 I = NBEGIN, NENC 
R ( 1 , 1 ) = 1.0 
R( 1,21 = 0.0 
265 R( I ,3) = 0.0 
290 REWIND 4 

ASSIGN 400 TO M 

IF (FLG12.NE.0) ASSIGN 300 TC M 
CO 700 I = 1, NT 
GO TO M, (300,400) 

300 READ (9) . ( A ( J ) ,J = 1,NT ) »(A(J) ,J=1,NT), (A(J) ,J = 1,NT) 
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GG TG 500 

AGO BEAD (9) t A t J),J=1,NT) 

5C0 CO 600 J - 1« NS IGA 
K = NT+J 

6C0 A(K)= R( I , J ) 

7C0 WRITE (3) (A(J),J=1,L) 

C AX I SYMMETRIC FLOW INPUT TO SOLVIT ON TAPE 3 

C OUTPUT FROM SOLVIT ON TAPE 3 

C TAPES 1 AND 2 ARE SCRATCH TAPES 

CALL SOLVIT (WK ARE A, NT, NS IGA, 16000,3, 1 ,2, 3 ,+9020) 

REWIND 9 

C ** * PREPARE CROSSFLOW MATRIX TAPE (11) 

C ** * SKIP SINA * REAC COSA 

8C0 IF (FLG04.EG.0) GO TC 1610 
K = 0 

L = NT+NSIGC 

IF (FLG22.GT.01 GO TG 91G 

READ (4) (A(I),I=l,NT),(A(I),I=l,NT) 

, IF (FLG17.NE.0) GOTO 820 
K = K + l 

CO 810 I = 1, NT 
810 R ( I , K ) = A(I) 

82C IF ( NNU ) 900,900,830 
83C CO 850 J = 1, KNU 

READ (4) MS , ( A ( I ) , 1= 1 , NT ) 

IF ( MS.EQ.0.OR.MS.EC.2.0R.MS.EQ.4) GO TO 850 
K = K+l 

CC 840 I = 1, NT 
840 R(I,K) = —All) 

850 CONTINUE 
9CC REWIND 4 
GC TO 1000 

C*** ***CROSS FLOW * GENERATED (RESEP) BOUNDARY CONDITIONS 
910 CC 920 I = 1 , NPB 1 
92C R ( I , 1 ) = -RHS(l) 

CC 930 I = NBEGIN.NENC 
930 R( 1,1) = 0.0 
10C0 ASSIGN 1300 TO M 

IF (FLG12.NE.0) ASSIGN 1200 TO M 
CO 1600 I = 1, NT 
GO TO M, (1200,1300) 

12C0 READ (10) (A(J),J=1,NT),(A(J),J=1,NT),(A(J),J=1,NT) 

C *** ***FORM PHI MATRIX FROM THETA (CROSS FLOW) MATRIX 

CG 1250 J = l, NT 
1250 A ( J ) = Y2( I) * A (. J ) • 

GO TO 1400 

13CC READ (10) (A(J),J-1,NT) 

14CC CO 1500 J = 1, NSIGC 
K = NT+J 

15CC A ( K ) =-R ( I , J) 

160 C WRITE (11) (A(J),J=1,L) 

C CROSS FLOW INPUT TC SOLVIT ON TAPE 11 

C OUTPUT FROM SOLVIT ON TAPE 3 

C TAPES 1 AND 2 ARE SCRATCH TAPES 

CALL SOLV IT (WKAREA»NT ,NS IGC, 16000, 11 , l, 2, 3, +9030 ) 

REWIND 10 
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1610 CONTINUE 

C*** ♦♦♦EXTRA CROSS FLOW 
REWINO 11 

IF (FLG21 .EQ.C.AND.FLG22.EG.Q ) RETURN 
K = 0 

L = NT + NS I GEC 

IF ( FLG22.GT .0 ) GO TC 1800 

C.*** ♦♦♦EXTR A CROSS FLOW * NCN-UNIFORM FLOW ONLY 

C**-* ♦♦♦SKIP RECORD WITH SINES AND COSINES 

READ (4) 

CC 1650 J= 1 , NNU 

READ(4) MS, (All), 1=1, NT) 

IF ( MS .LT . 2.0R.MS.EQ.3) GO TO 1650 
K = K* 1 

CO 1640 I = 1 , NT 
1640 R(I»K) = A(I) 

1650 CONTINUE 

GO TO 1900 

C*** ♦♦♦EXTRA CROSS FLOW ♦ GENERATED (RESEP) BOUNDARY CONDITIONS 

1800 DO 1820 I = 1 , NPB1 
1820 R( 1,1) = COSSCR< I ) 

CO 1840 I = NBEGIN.NENC 
1840 R(I,1) * 0.0 
1900 REWIND 4 

(;,♦>♦♦ ♦♦♦M IS 1920 ♦ SCLVE A MATRIX 

ASSIGN 1920 TO M 

C ♦ ♦ * ♦ ♦♦M IS 1940 ♦ SCLVE POTENTIAL MATRIX 

IF (FLG12.NE.OASSIGN 1940 TC M 
CO 1980 I = 1 , NT 
GO TO M, (1920,1940) 

C*#* ♦♦♦SOLVE A MATRIX 
1920 READ (8) (A(J),J =1,NT) 

GO TO 1960 

1940 READ (8) ( A ( J ) , J= 1 , NT ) , ( A ( J ) , J = 1 , NT ) , ( A ( J ) , J = 1 , NT ) 

C*** ♦♦♦FORM PHI MATRIX FROM THETA (EXTRA CROSS FLOW) MATRIX 
CC 1950 J = 1 , NT 
1950 A( J) » Y2( I) ♦ A(J) / 2.0 
I960 CO 1970 J = l.NSIGEC 
K = NT ♦ J 
1970 A ( K ) = R( I,J) 

1980 WRITE (11) ( A ( J ) , J=1 , L ) 

C** * ♦♦♦EXTRA CROSS FLOW INPUT TO SOLVIT ON TAPE 11 

C*** ♦♦♦OUTPUT FROM SOLVIT ON TAPE 3 

C*** ♦♦♦TAPES 1 AND 2 ARE SCRATCH TAPES 

CALL SOLVIT ( WK ARE A, N T ,NS I GEC , 16C00 , 1 1 , 1 , 2 , 3, +9040 ) 

REWIND 8 
REWIND 11 
RETURN 

2000 NR = NT-NMA 
L = NMA+1 

READ (4) (R( I,1),I=1,NMA) 

READ (4) ( FF ( I ), 1 = 1, NR) 

CO 2100 I = 1, NR 
2100 F F ( I ) = F F ( I ) /FGURPI 

EACKSPACE 4 ' 

WRITE (4) ( FF ( I ) , 1=1 , NR ) 
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REWIND 4 

CC 2300 1 = 1, NMA 

REAO <91 !A!J),J=l»NMA),<T<J),J=l » NR ) 

CC 2200 J = 1 , NR 
2200 R!l,l) = R!l,l)- TIJHFFIJI 
AIL) = R ( I » 1 1 
23CC WRITE (3) <A!J),J=1,L) 

C PRESCRIBED VCRTICITY INPUT FOR SOLVIT ON TAPE 3 

C CLTPUT FROM SOLVIT ON TAPE 3 

C TAPES 1 AND 2 ARE SCRATCH TAPES 

CALL . SOL V l T ( WK ARE A , N M A , L - NM A , 16000,3, 1,2,3, *9000 ) 

REWIND 9 
CC TO 800 

90CC WRITE! 6 ,900 1 ) 

9CC1 F0PHATI61H NOT ENCUGH SPACE RESERVED IN SOLVIT FOR PRESCRIBED VORT 
1 ICITY) 

GC TO 9080 

9010 WR I T F ( 6,901 1 ) 

9011 FORMAT (71H NCT ENOUGH SPACE RESERVED IN SOLVIT FOR PRESCRIBED TANG 
1 ENT I At VELOCITY) 

CC TO 9080 

9020 WRITE 16,9021) 

9021 FORMA T(58H NCT ENOUGH SPACE RESERVED IN SOLVIT FOR AX I SYMMETR IC FL 
1CW) 

C-C TO 908 0 ^ 

9030 WRITE! 6,90 3 1 ) 

9031 FORMAT (51H NCT ENOUGH SPACE RESERVED IN SOLVIT FOR CROSS FLOW) 

GO TO 9080 

9040 WRITE <6,9041 ) , , 

9041 FORMAT !57H NOT ENOUGH SPACE RESERVED IN SOLVIT FOR EXTRA CROSS FL 
1CW) 

9080 STOP 
END 
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C20XS 


SUBROUTINE 

SOLVIT 

(A, NC, 

MC, KD, 

NI, MM, 

NO, NW, *) ; 
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WRITTEN BY J. L. HESS * PROGRAMMED BY T, M, RIODELL 

p I MENS ION A I KD ) 

LOGICAL LAST 

CALL TIMEV(^Al) 

N' * ND 
K = MO 
KORE = KO 
NPM = N 4 M 

IF (MAX0I3 '* IN PM, M * N) .GT. KORE) RETURN 1 

Mr = mm ' ' 

REWIND MT 
MN = NI 
CEBUG NIN tM , NO 
REWIND NIN 
NGUT = NO 
REWIND NGUT 
MPl = M ♦ I 
MN = N 
NEL = NPM, 

- - CALCULATE THE MAXIMUM NO. CF ROWS, *KN 
10 K = (KORE - NEL). / NEL 

- - TEST TO SEE IF THE REST CF THE MATRIX WILL FIT IN CORE 

LAST = K .GE. NN 
IF (LAST) K = NN 

READ * K*. ROWS OF THE AUGMENTED 'A* MATRIX 

30 NT = 0 

CO AO IB = I, K 
NS = NT ( 1 
NT = NT + NEL 
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AC READ (NIN) (AUC). IC * NS, NT ) 

- - CHECK TO SEE IF WE WERE UNLUCKY ENOUGH TO ENO UP WITH ONLY ONE ROW 

IF <K V .EQ. 1) GO TO 9C 

' K • IS GREATER THAN *1* SO WE CAN START THE TR I ANGULAR 1 1 AT I ON; 

NELP1 = NEL +1 , 

NS = - NEL 
NELP2 = NELP1 + I 

- - FORK THE ' TRAPEZC 10AL • ARRAY (8) 

* • ' . 

CG 50 IB = 2, K 
NP = NELP2 - IB 
NS = NS 4 NELP1 
NT = NS 

CO 50 IC = IB, K 
NT = NT 4 NEL 

PN = NT 

NB = NS 

A ( NT ) = ( - A ( NT ) ) / A ( N S ) 

CC 50 NF = 2, NP 
PN = MN + 1 

NB = NB 4 l 

50 A ( MN ) = A ( PN ) + A ( NT ) * A( NB ) 

IF (LAST I GC TO 90 

WRITE THE ’ TRAPEZOIDAL ' MATRIX ON TAPE 

NT = 0 
NP = NEL 
NS = - NEL 
CO 60 10 = I, K 
NS = NS 4 NELP1 
NT = NT 4 NEL 

WRITE (NT) NP, ( A ( 1 8 I , IB = NS, NT) 

60 NP = NP - 1 

NP = NP - M 

NS = KORE - NEL +1 

- - READ ANOTHER ROW 

CO 80 10 = 1, NP 

READ (NIN) (A(IB), IB = NS, KORE). 

PCD I FY THIS ROW BY THE 'TRAPEZOIDAL* ARRAY 

NT = 1 
PN = NS 

CO 70 IB = 1, K 
NB = NT 
NF * MN ♦ 1 

A ( MN ) = ( — A ( MN ) ) / A ( NT ) 

CG 65 NN = NF, KORE 
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NB = N8 4 1 

65 AtNN) = A ( NN ) + A ( KN ) * A( NB ) 

NN = NF 

7C NT = NT 4 NELP1 

WRITE THE NOOIFIEC RCW ON TAPE 

80 WRITE (NOUT) ( A ( N T ) , NT = MN,* KORE) 

REWIND NOUT 
REWIND NIN 

- - SWITCH THE TAPES 

NT = NIN 
NIN = NOUT 
NCUT = NT 

RE-CALCULATE ROW LENGTH ANC LCOP BACK 

NEL = NEL - K 
f*N = NEL - M 
GO TO 10 

REWIND ALL TAPES 

90 REWIND NT 
REWIND NIN 
REWIND NOUT 

CCNCENSE THE MATRIX 

rN = NEL 
NL = NELP1 

IF (K .EQ. 1) GO TO 1G5 
NS = 1 

NT = NEL 

CC 100 IB = 2, K 
NS = NS 4 NELP1 

NT = NT 4 NEL 

CO 100 10 = NS, NT 
A ( NL ) = A( Id 
100 NL = NL ♦ l 
105 N1 = KORE - K * M ♦ 1 

THERE, NOW WE CAN START THE EACK-SOLUTION 

* * NOTE.. THE FIRST AVAILABLE LOCATION FOR THE SOLUTIONS IS A(N1) 

NREK = N 
NEL = NPW 
LAST = K .EQ. N 
NP ASS =0 

- - SOLVE FOR THE ANSWERS CORRESPONDING TO 'K' ROWS 

110 KN1 = K - 1 
KP1 = K 4 1 
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NS = NL - HP 1 
N PAS'S = NPASS + 1 
CO 130 MN = 1, M 
NF = NS *. MN 
fl(NF) = A ( NF ) / A ( NS ) 

NT = NS 

IF { KM1 .EC. 0) GO TC 130 
CO 125 IB = 1, KM1 
NF = NF - IB - M 
N'T = NT - HP 1 - IB 
SUM = 0.0 
NP = NF 
N2 = MP1 ♦ IB 
CC 120 10 = 1, IB 
NN = NT 4 10 
NP = NP *. N2 - 10 
12C SUM = SUH 4 A INN) * A(NP) 

125 A ( NF ) = { A ( NF ) - SUM) / A( NT ) 

13C CONTINUE 

HOVE THE SOLUTIONS TC CONTIGUOUS LOCATIONS STARTING AT A(N1) 

N1 = KORE + 1 
CC 140 NN = 1, K 
CC 135 MN = l, M 
NL = NL - 1 
N1 = N1 - 1 
135 A ( N1 ) = A ( NL ) 

IAC NL = NL - NN 

WRITE THE SOLUTIONS CN TAPE 

WRITE ( N I N ) K 
NS = N1 - 1 
CO 145 HN = 1, H 
NT * NS ♦ MN 

145 WRITE I NIN 1 C A < IG ) » 10 = NT, KORE, M) 

- TEST IF THIS IS THE LAST PASS 
IF (LAST) GO TO 200 

WE MUST NCW MODIFY THE TRIANGULAR MATRIX TO REFLECT THE EFFECT OF 

THE SOLUTIONS OBTAINEC SO FAR (EQ 21) 

* * NOTE.. LOCATIONS A(l) TC A(Nl-i) ARE NOW FREE TO USE 

- - CALCULATE THE NEXT VALUES OF * NEL * AND 'NREM* 

NELCLD = NEL 
KOLD = K 
NEL = NEL - K 
NREM = NREM - K 

NOW APPLY THE INCREDIBLE FORMULA FOR. THE NEW. *K* 

K = ( — 4 * M - 1) / 2 ♦ I F I X ( SORT ( 0-. 2 5 + FLOAT ( ( 4 * M + 2) * M + 
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12* (KCRE - NELOLD) I ) ) 

NROW = NREM - K + 1 

IF (K .LT. NREM ) GO TC 150 

LAST = .TRUE. 

NROW =1 
K = NREM 
150 NS = 1 

NT = NELOLD +1 

READ IN THE ROWS TO BE MODIFIED 

CO 190 IB = 1, NREM 
NT = NT - 1 

IF (IB .LE. NROW ) GO TC 160 
NS = NS 4 NN 
NT = NT ♦ NN 

16C READ ( MT ) NN, (A(IC), 10 = NS, NT) 

NP * N1 - 1 
NF = NT - M - KM1 
NN = NN - KOLO 
CC 170 MN = 1, M 
N2 = NF 
NA = NP ♦ MN 
NB = NA 
SUM =0.0 

CO 165 10 = 1, KOLD 
SUM = SUM + A(N2) * A(NAI 
N2 = N2 4 1 
165 NA = NA .♦ M 

N2 = N2 4 MN - 1 
170 A ( N2 ) = A ( N2 ) - SUM 

- - WRITE THE KOCIFIEC ROW ON TAPE OR CONDENSE THE ROW 

NL = NT - M ♦ 1 

IF (IB .GE. NROW) GO TC 175 

NF = NL - K PI 

WRITE (NOUT) NN, (A(IC), 10 = NS, NF ) , (A(IO), 10 = NL , NT) 
GO TO 190 

175 NF = NL — KOLD 

CO 180 MN = NL, NT 
A ( NF ) = A ( MN ) 

180 NF = NF 4 1 ' 

190 CONTINUE 
REWIND MT 
REWIND NOUT 

SWITCH THE TAPES 

NT = MT 
MT = NOUT 
NOUT = NT 

LOOP BACK THRU THE SOLUTION 

NL = NF 
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GO TO 110 


START TO WRAP IT UP 

2CC REWIND NIN 
N 2 = N 

* * NOTE.. AT THIS POINT ALL LOCATIONS A(l) THRU A(KORE) ARE FREE 

CO 220 IB = 1, NPASS .. 

READ ( NIN ) K 
N1 = N2 - K + 1 . 

NS = N1 

NT = N2 v ^ 

- - RE'AC. IN THE SOLUTIONS 

CO 210 10 = I* M 

READ (NIN ) (A(NN), NN = NS, NT) 

NT = NT 4 N 

2 1C NS = NS + N 
220 N2 * N1 — 1 

REWIND ALL INPUT TAPES 

REWIND NIN 
REWIND MT 
REWIND NOUT 

WRITE THE SOLUTIONS ON TAPE 

NT = 0 

CC 230 10 = I, N 
NS = NT 4 1 
NT = NT 4 N 

230 WRITE <NW) ( A ( NN ) , NN = NS, NT) • 

CALL T IME V ( AA2 ) - 

EB = (AA2 - AA1) / 60. 

WRITE (6, 300) N, N, M , EB 

300 FORMAT ( 4H0THE 15, 2H X 15, 12H MATRIX WITH 14, 35H RIGHT SIDES WA 
IS SOLVED DIRECTLY IN F8.3, 9F MINUTES. ) 

RETURN 

END 
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C 

SUBROUTINE PART4 
C 

C * COMPUTE VELOCITY COMPONENTS AND PRINT 

C 


COMMON 

H£DR< 10) 

.CASE 

, NB 

, NNU 


1 

t FLG03 

, FLG04 

, FLG05 

, FLG06 

, FLG07 

2 

t FLG08 

,FLG09 

tFLGlO 

»FLG11 

, FLG12 

3 

t FLG1 3 

, FLG14 

, FLG15 

,FLG16 

,FLG17 

4 

, FLG18 

, FLG19 

, FLG20 

, FLG2 1 

, FLG22 

5 

t FLG23 

, FLG24 

, FLG25 

, FLG26 

, FLG27 

DOUBLE 

PRECISION HEDR 

, CASE 




INTEGER 

FLG03 

, FLG04 

, FLG05 

, FLG06 

, FLG07 

1 

> FLG08 

, FLG09 

, FLG 10 

,FLG11 

,FLG12 

2 

» FLG1 3 

, FLG1 4 

, FLG15 

,FLG16 

, FLG17 

3 

• FLG18 

, FLG19 

,FLG20 

,FLG21 

, FLG22 

4 

» FLG23 

, FLG24 

, FLG25 

,FLG26 

,FLG27 

COMMON 

NT 

,ND( 11 ) 

,MN 

,NUNA ( 4 ) 

, TYPE A ( 4 ) 

1 

tNERl 

,NER2 

, NMA 

yNSIGA 

,NSIGC 

2 

, NUNC (4) 

,TYPEC(4) 

,NLF (11) 



COMMON 

IEC » NSIGEC, T Y PE EC < 4 ) » NUNEC(4) 



REAL 

MN 




. 

COMMON 

/C4/ X1I500), 

Y1 ( 500 ) • 

X2 ( 500 ) , 

Y2I500), 

DELS ( 500 ) , 

1 

SINAI50C ) » COSA ( 500 ) 

t XP( 500 ) , 

YP ( 500 ) 


COMMON 

/TC/ RB(500,8),SIG(500,4), A(500), BI500), Z(500 

1 

PHI ( 500 t 

4) , 

XN( 500,4) , 


2 

T( 500,4) 

, T3( 500,4) 

, NSIG, 

NP, 

NI, SUMV 


c 

C * START 

REWIND 3 

IF (FLG05.E0.0) GO TO 30 
C * READ OFF— BCCY XP,YP 

NP=ND( NB* 1 ) 

READ <121 (XP( I ),I=1,NP),(YP(I),I=1,NP) 

C * READ X1,Y1,X2,Y2,CELS WITH MACH NO. ADJUSTMENT IF ANY 

30 N I =NT+NB 

READ (12) ( X 1 ( I )»I~1»NI ) » ( Y 1 ( I ) , 1 =1 « NI ) , ( X2 ( 1 )»I = 1»NT) 

1 , ( Y2 ( I ) »I=. l»NT)»(DELS(l)»I = l»NT) 

C * READ SINA,CCSA,NO,TO.. 

RE AO (4) (A(I), 1=1, NT), (Btl), 1*1, NT) 

SUMV = 0.0 
EC 100 I = 1, NT 
SINAU) =5 A ( I ) 

COS A ( I ) = B ( I ) 

100 SUMV = SUMV ♦ B( I )*DELS ( I ) *Y2 ( I )**2 
SUMV = SUMV*3. 141593 
IF (FLG03.LE.0) GO TO 1000 
L = 1 
LS = 0 

IF (FLG16.NE.Q) GO TO 200 
DC 150 I = 1, NT 
RBI I *L ) =s A ( I ) 

150 RB ( I »L + 1 ) = B ( I ) 





200 IF ( NNU ) 600,600,300 
3CC CC 500 J = I, NNU 

READ (A) PS, (All), 1=1, NT), (BCI), 1=1, NT) 

IF (MS.EQ.1.0R.MS.EQ.2.0R.MS.EQ.5) GO TO 500 
L = L + 2 
LS = LS + 1 

IF (LS.EQ.1.AN0.FLG16.GT.0) L=L-2 
CC AOO I = 1, NT 
R B 1 1 , L ) = A(I| 

ACC R8(I,L+1) = 6(1) 

5C0 CONTINUE 

600 REWIND A '"'Y • 

NS IG = NS IGA 
CALL AXIS 

iOCO IF (FLGOA.LE.O) GOTO 2CC0 
IF (FLG03.LE.0) GO TO 1050 
READ (A) (A(I),I=1,NT),(B( I), 1=1, NT) 

105 C L = 1 
LS=0 

IF (FLG17.NE.0) GO TO 1200 
CO 1100 I = it NT 
RB ( I ,L ) = A (I ) 

11C0 RB(I,L + 11 = H C I ) 

1200 IF (NNU) 1600,1600,1300 
13CC CC 1500 J = 1, NNU . 

READ (A) PS, (A< I ) ,1 = 1 ,NT ), C B C I ) ,1 = 1, NT) 

IF ( MS.EQ.O.OR.MS.EG. 2 . OR .MS . EQ. A ) GO TO 1500 
L = L+2 
LS = L S+l 

IF (LS.EQ.I.AND.FLG17.GT.0) L=L -2 
CC 1 AOO I = 1, NT 
RB ( I , L ) - A ( I ) 

1 ACC RB ( I.L + l) = B ( I ) . 

15 CC CONTINUE 
16CC REWIND A 

NS IG = NSIGC 
CALL CROSS 

20 CC IF (FLG21.LE.0) RETURN 
REWIND A 

IF1FLG22.GT.0) GO TO 2A0C 
L = 0 

C*** ***lf CONTROL REACHES' THIS POINT, THERE IS AT LEAST 1 NNU 

C*** ***SKIP RECORD WITH SIN AND COS 
READ (A) 

CC 2200 J = 1 » NNU 

READ ( A ) PS, ( A(I.), 1 = 1, NT ), ( B(I),I=1,NT ) 

L = L + 1 
CC 2200 I = 1,NT 
RB ( I ,L ) = A(I ) 

22C0 RB ( I ,L + 1 ) = Bd ) 

2AC0 REWIND A 

NS I G = NSIGEC 

C*** ***OALL TC EXCROS FOR GENERATED (RESEP) BOUNDARY CONDITIONS 
CALL EXCRCS 
RETURN 
END 
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$1 BFTC AXIS 


DECK 


C 

C 

C 

C 


C 

C 

C 

C 

C 

C 

C 


SUBROUTINE AXIS 



* 

COMPUTE AXISYMMETRIC 

VELOCITY COMPONENTS AND PRINT 

COMMON 


HEDR(IO) , C ASE 

,NB 

,NNU 


1 


, FLG03 , FLG04 

, FLG05 

, FLG06 ' 

, FLG07 

2 


, FLG08 , FLG09 

, FLG10 

* FLG1 1 

, FLG12 

3 


, FLG1 3 , FLG1 4 

, FLG15 

, FLG16 

,FLG17 

4 


, FLG18 , F LG 19 

, FLG20 

, FLG2 1 

,FLG22 

5 


, FLG2 3 , FLG24 

, FLG25 

, FLG26 

,FLG27 * 

COUeLE 

PRECISION HEDR, CASE 




INTEGER 

FLG03 , FLG04 

, FLG05 

, FLG06 

, FLG07 

1 


, FLG08 ,FLGC9 

, FLG10 

,flgu 

, FLG12 

2 


» FLG1 3 , FLG 14 

, FLG15 

, FLG16 

, FLG17 

3 


, FLG1 8 , FLG19 

, FLG20 

,FLG21 

»FLG22 

4 


, FLG2 3 , FLG24 

, FLG25 

, FLG26 

, FLG27 

COMMON 


NT ,NC( 11) 

,MN 

,NUNA ( 4 ) 

, T YPEA (4) 

1 


, NER1 ,NER2 

, NM A 

, NSIGA 

,NSIGC 

2 


, NUNC ( 4 ) , T YPEC ( 4 ) 

, NLF ( 1 1 ) 



COMMON 

IEC , 

NSIGEC, TYPE EC (4 ), 

NUNEC ( 4 ) 



COMMON 

/P/ 

IPUVEL 




REAL 


MN 




COMMON 

/C4/ 

Xl(500), YK5C0) 

* X2( 500 ) , 

Y2 ( 500 ) , 

DELS ( 500 ) , 

1 


SINAI 500 ),COSA( 50G) ,XP(500) , 

YP ( 500 ) 


COMMON 

/TC/ 

RB(500,8),SIG(500 

,4), A ( 500 ) , B ( 500 ) , Z(500 

1 


PHI ( 500 ,4 ) , 

XN( 500,4), 


2 


T ( 500, 4 ) , T3 ( 5C0 , 

4), NS IG 

, NP, 

NI, SUMV 

3 


, SUMM ( 4 ) 




CIMENSICN 

VX(500,4),VY(500, 

4 ) ,VT ( 500, 4) 

, TH( 500, 4 ) , 

CP (500,4), 

1 


SUMTDS ( 4 ) 




EQUIVALENCE 

( VX(1,1) , XN(1,1) ) , { VY ( 1 , 

1 ) ,T( 1, 1 ) ) 

, 

1 ( VT(1,1) 

, T3 ( 1,1) ), ( THU, 

1 ), S I G ( 1 , 1 ) 

), (CP ( 1.1) 

,T3(1,1) ) 


EQUIVALENCE (VY.VYDP ) , I VT, VTOP ) , { T , TOP ) , ( VX , VXDP > 

DIMENSION TDPIl) ,VXDP(1) ,VYDP|I), VTDPII) 

* START 

NC = NT 

IF (FLG19.GT.0) NC=NM A 
IF (FLG08.EQ.Q) GO TC 10 

* TITLE FOR MATRIX PRINT 
WRITE (6,150) HEDR.CASE 

WRITE (6,8) 

8 FORMAT (1H 4 3H MATRICES A,B,Z BY ROWS * AXISYMMETRIC FLOW //) 

* READ AXIS SIGMAS 
1C CO 20 N= 1 , NS I G 

SUMM ( N ) =0 • 0 
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SUMTOS t N ) =0 .0 

2C READ (3) (SIGCI,N),I=1»NC) 

IF (FLG19.LE.0) GC TC 25 
READ (A) 

NR = NMA+1 

READ (A) ( S I G ( I , 1.) » I =NR , NT ) 

REWIND A 

C * NC. OF MIDPOINTS LOOP 

. 25 CO 100 1=1 , NT 

C * KEAD MATRICES A,B,Z 

READ (9) (A ( J) , J = 1 , N T ) * ( 8 ( J ) , J = 1 » NT ) , ( Z ( J ) »J = 1»NT) 
C * NC. OF FLOWS LOCP 

M=C 

CO 70 N=1,NS1G 

Nl=Nl+2 

SN = 0 .0 

ST = 0 .0 

SP=0.0 

C * NC. OF ELEMENTS LCOP 

CC 30 J=1 » NT 
SN=SN+A( J )*SIG( J,N) 

ST=ST+B( J )*SIG( J.N) 

3C SP=SP+Z(J)*SIG(J»N) 

IF ( FLG22.GT.0 ) GC TO 6 8 
IF (FLG12.EC.0) GO TC AO 
XN( I ,N)=SN 

PHI ( I,N)=SP-RB( I,M-1 ) 

CC TO 50 

AC XN( I,N)=SN-RB< I,N1-1 ) 

PH II I , N ) = SP 

5C IF (FLG11.EC.0) GC TC 60 
T(I,N)=ST 
GC TO 65 

6C T( I ,N)=ST+RB(I,N1) 

65 SUMM (N) = SUMM(N) + PHH ! ,N»*Y2< I ) *RB (I , Nl- 1 ) *DELS ( I ) 
CP(I,N)=1.-T(I,N)**2 
GO TC 7C 
68 XN( I «N ) = SN 
PH I { I » N ) = SP 
T< I ,N) = ST ‘ 

CPI I , N ) = 1.0 - T(I,M**2. 

7 C CONTINUE 

I F ( FLG08. EC.O ) GO TO ICO 
WRITE (6,80 I, (A(J) , J=1,NT) 

80 FORMAT C1H0 13H MATRIX A ROW. 16/ I 1H 10F10.5J) 
WRITE (6,85) I,(B(J) * j = 1 »NT ) 

85 FORMAT (IHC 13H MATRIX B RCW 16/ ( 1H 1GF10.5)) 
WRITE (6,90 I »(Z(J) , J = 1 ,NT ) 

90 FORMAT MHO 13H MATRIX Z ROW 16/ ( IH 10F10.5)) 

ICC CONTINUE 

IF (MN.EC.C.O) GC TO 130 
C A MACH NC. ACJUSTMENT 

Cl = MN*MN -.1 . 

C2 = 1 .-Dl 

C3=SQRT(C2 ) - 

CA= . 7*D1 


JO 


* 



C5 = • 2*01 
CC 120 N= 1 »NS IG 
CC 120 1 = 1, NT 

TX= ( T 1 1 » N ) *CCSA 1 1 )-l • j /D2+ 1 • . 

TY = I T| I,N» * SINAI I) ) / C3 
s T( I ,N)=SGRT(TX*TX+TY*TY) 

12C CP( i ,N) = ( (l.*D5*(l.-T(I,N>**2) )**3.5-l. ) /DA ' 

G f ... * ELIMINATE MACH NO EFFECT FOR PRINTOUT 

■ t ■■ CC s 122 1 = 1, NI 
i 2 2 Xl( i j = Xl( I 1*03 

k=o 

J1=C 

be 126 K = 1 , N 8 
M = N+ 1 

K=N+Nb(k)-1 . 

CC 12A j = M,N 

ji=Ji+i 

ti=xii ji+n-xi( jij 
T2=Y1( ji+1 )-Yl( jl ) 

X 2 ( J)=(xi( Ji+ii+xiiji i )/ 2 . 

CELS( j)=SCRT(Tl*Ti+T2*T2 ) 

C 0 S A I j )=T1/DELS( J ) 
i2A SINAI j)=T2/DELS( J) 

. i 2 6 Ji=ji+i , . 

C * PRINT AXIS FLOW ( ON-BODY I OUTPUT 

130 CC 250 L=1,NSIG 
KA = L 

IF (Fi_G16.LE.O) KA=L-1 
IF (FLG22.Gt.GI KA = L 
IF ( FLG22.GT .0 )GG TC 136 
SUMMiL»=-6.283i853*SLMM(Li 
, „ CC 135 J = 1, NT 

135 s’UMTDSll j = SUMTDS(l) + T( JiL j*bELS( J ) 

1 36 I = 1 

j = i 

M = 1 

N=NC(M) 

. L C t R = 2 2 

l^C WRITE (6,150) HECR.CASE 

150 FORMAT (IH1 25X, 26HCCLGLAS AIRCRAFT COMPANY / 

1 28 X , 21HLCNG EEACH DIVISION III 

2 6 X , 10A6, AX, IOHCASE NO. A6 // j 
IF (FLG22.GT.0) GC TC 176 

IF (l.GT. I.CR.FLG16.NE.0 I GO TO 170 
v .WRITE (6,160) 

16C FORMAT (1H 3 AH ON-BODY UNIFORM AXISYMMEIrIC FLOW ) 
j GO TO 190 - . 

17C IF ( TYPEA(KA) .GE.0.0 ) GO TC 175 
WRITE (6,172) - 

1 7 2 FORMAT (lH A AH FLOW GENERAtOR * ROTAtlNG BODY * TYPE ERROR ) 
175 IF ( NUN A I K A ) .EQ. 1 23456 ) WRITE (6,i77) 

177 FORMAT (27H CN-BODY STRIP VCRTEX FLOW,), 

178 IF (NUNAIKA j.NE.123A56) WR I TE ( 6 , 1 80 ) NUN A ( K A ) 

ieO FORMAT (1H A2H CN-BODY NON-UN 1 FORM A X I S YMMETR 1 C FLOW NOi 18) 
ISO WRITE ( 6 , 2CC ) 

200 FORMAT (IH 5X 2AH tR A NS FORM EC COORDINATES // 



1 12X 1HX 13X 1FY 13X 2HT1 12X 2HCP 9X 5HSIN A 

2 6X 5HC0S A 7X 5HSIGMA 11X 1HN 13X 3HPHI // ) 

210 WRITE (6,220) I , XI ( I ) , Y1 (I) , X2 < J ) , Y2 < J ) , T ( J, L ) , CP ( J , L ) , 

1 SINA( J),CCSA( J),SIG(J,L),XN(J,L),PHI(J,L) 

220 FORMAT ( 1H I3,2F1A.7/ AX AF 1 A. 7 , 2F 1 1 . 5 , 3F1 A. 7 ) 

1=1+1 
J = J+ 1 

IF ( l.EQ.N) GO TO 230 < 

IF (I.LE.LCTR) GO TO 210 
LCTR=LCTR+22 
GO TO 1A0 
230 MM+1 

N=N+ND( M ) 

WRITE ( 6 , 2 AO ) I , X 1 ( I ) , Y 1 ( I ) 

2 AO FORMAT <1H 13, 2F1A.7 // ) 

1 = 1 + 1 

IF ( J - NT ) 210, 2A2, 2A2 
2A2 IF(FLG22.GT.O) GO TO 250 

WRI TE( 6,2AA ) SUMM(L), SUMV, SUMTDS(L) 

2AA FORMAT (1HC 1CX 13H ACCEC MASS =F12.7, AX 9H VOLUME = F12.7, 

A 5X 18HSUM (TMOELTA S) = F12.7 ) 

250 CONTINUE 

CALL BCOUMP ( X2( 1 ) , X2 ( NT ) ) 

CALL BCDUMP ( Y2 ( 1 ) * Y2 ( NT ) ) 

CALL BCDUMP ( TCP(1),TCP(NT)) 

IF (IPUVEL .EQ. 0) GC TO 252 

LCC =100 . 

CALL PUNCHC (X2, NT, LCC, CASE ) 

LCC = 500 

CALL PUNCHC ( Y2, NT, LOC, CASE ) 

LCC =900 

CALL PUNCHV ( T, NT, NSIG, LCC, CASE ) 

252 IF (FLG05.EG.0) RETURN 
C * OFF-BODY PCINT 

IF (FLG15.LE.0) GO TC 258 
M = 0 

CO 25A I = 1, NB 

25A IF ( NLF ( I ) .LE. 0) M = M + 1 
IF ( M .EG. 0 ) GC TC 258 
MM = NNU +1 

CO 255 I = 1, MM 

255 READ (A) 

IF (FLG22.GT.0) READ! A ) 

CO 256 J = 1, M 

256 RE AD ( A ) (RB(I,J),I = 1,NP), (T3(I,J),I i 1,NP| 

REWIND A 

258 CO 300 I = 1, NP ■ ■ „ 

L = 0 

C * READ MATRICES X,Y,Z 

READ (9) ( A ( J.) , J = 1 ,NT ) ,.( B( J )., J = 1 , NT) ,.( Z ( J ) , J = 1 , NT ) 

C * NO. OF FLOW 

DO 300 N=1,NSIG 
KA = N 

IF (FLG16.LE.0) KA=N-1 

SX=0.0 

SY = 0 .0 


\0H 



SP=Q.O 


C * NO. OF ELEMENTS LOOP 

CC 260 J=1,NT 
SX=SX+A( J)*SIG( J,N> 

SY=SY+B( J)*SIG( J,N) 

260 SP=SP+Z< J )*SIG( J,N) 

PHI(I,N)=SP 

IF (FLG22.GT.0) GO TO 27C 
IF (FLG11.GT.0) GO TO 27C 
IF ( N.NE. 1 .0R.FLG16.GT .0 ) GO TO 262 
V X ( I » N ) =f SX + 1. 

GO TO 280 

262 IF (NUNA(KA).NE. 123456) GO TO 270 
L = L + 1 

VX( I ,N)=$X+RB( I »L) 

VY( I ,N)=SY+T3( I ,L) 

GO TO 3C0 
270 VX ( I . N ) =? SX 
260 V Y ( I y N ) =5 SY 
300 CONTINUE' 

IF ( MN.EQ.0.0 ) GO TO 230 
C * MACH NC. ADJUSTMENT 

CC 320 N=I yNSIG 
CC 320 I=?1,NP 
VY( I,N)=VY(I ,N)/03 
320 VX( I ,N) = f VX( I ,N)-1. ) /C2+1. 

. CC 322 I * It NP 
322 XP ( I |=XP( I ) *03 

C * COMPUTE VT ANC THETA 

330 CC 335 N=l,NSIG 
CC 335 I^l,NP 

VT( I,N)=SGRT(VX( I,N)**2*VY( I,N>**2) 

335 TH< I,N)-ATAN2(VY( I,N),VX(I ,N> > * 57.29578 
C * PRINT AXIS FLOW ( CFF-80DY ) OUTPUT 

CC 450 L=i 1 y NS I G 
KA = L 

IF(FLG16.LE.O.ANO.FLG22.LE.O) KA = L - I 
1 = 1 

LCTR=45 

340 WRITE (6,150) HEORyCASE 

IF ( L.GT . 1 .0R.FLGI6.NE.0 ) GO TO 370 
IF ( FLG22.GT .0 ) GO TO 378 
WRITE (6,360) 

360 FORMAT (1H 35H OFF-BCCY UNIFORM AXISYMMETRIC FLOW ) 

GO TO 390 

370 IF (TYPEA(KA).GE.O.) GO TO 375 
WRITE (6,172) 

375 IF (NUNA(KA).EQ. 123456) WRITE (6,377) 

377 FORMAT (28H OFF-BODY STRIP VORTEX FLOW) 

378 IF (NUNA(KA).NE. 123456) WRITE (6,380) NUNA(KA) 

38C FORMAT (1H 43H CFF-BCCY NON-UNIFORM AXISYMMETRIC FLOW NO. 18) 

390 WRITE (6,400) 

4C0 FORMAT (1H 5X, 24H TRANSFORMED COORDINATES // 

1 1 2 X 1HX 13X 1FY 13 X 2HVX 12X 2HVY 12X 2HVT 10X 

2 5HTHETA UX 3FPHI // ) 

410 WRITE (6,420) I , XP ( I ) , YP ( I ) 


/ 05 * 


t 


VX( I , L ) , V Y ( I , L ) , VT ( I ,L) , 


1 TH ( I » L) t PH I ( I , L ) 

420 FORMAT < 1 H 13, 7F14.7) 

1 = 1 + 1 

IF (I.GT.NP) GC TO 45C 
IF (I.LE.LCTR) GO TO 410 
LCTR=LCTR+45 
GC TO 340 
45C CONTINUE 

CALL BCOUMP (XP ( 1 ) , XP ( NP ) ) 

CALL BCCUMP ( VP ( 1 ) , YP ( NP ) ) , 

CALL BCOUMP ( VXDPI 1 )» VXCP (NP ) ) 

CALL BCDUMP(VYCP( II » VYCP (NP ) ) 

CALL BCOUMP ( VTDP ( 1 >, VTCP (NP ) ) 

5C0 IF ( IPUVEL .EG. 0) RETURN 
LCC =2500 

CALL PUNCHC ( XP, NP, LOC, CASE ) 
LCC = 2900 

CALL PUNCHC ( YP, NP, LOC, CASE ) 
LCC = 3300 • - • 


CALL 

PUNCHV 

( VX, 

NP, 

NSIG, 

LOC, 

CASE 

) 

LOC 

= 4900 







CALL 

PUNCHV 

( VY, 

NP, 

NS IG, 

LOC, 

CASE 

) 


RETURN 

ENO 



)QLc 





IBFTC CROSS 

OECK 





SUBROUTINE 

CROSS 






* 

COMPUTE CRCSS FLOW VELOCITY COMPONENTS AND 

PRINT 

COMMON 


HEDR( 10) 

♦ CASE 

, NB 

, NNU 


1 


, FLG03 

, FLGOA 

, FLG05 

, FLG06 

, FLG07 

2 


, FLG08 

, F LGC9 

, FLG10 

,FLG11 

, FLG 12 

3 


» FLG1 3 

, FLG 1 A 

• FLG15 

, FLG16 

, FLG1 7 

A 


, FLG18 

» FLG19 

, FLG20- 

,FLG21 

, FLG22 

5 


, FLG23 

, FLG2A 

, FLG25 

, FLG 26 

, FLG27 

CCUELE 

PRECISION HECR 

, CASE 




INTEGER 

FLG03 

, FLGOA 

, FLG05 

, FLG06 

, FLG07 

1 


, FLG08 

, FLG09 

• FLG10 

»FLG1 1 

,FLG12 

2 


, FLG1 3 

, FLG1A 

, FLG 1 5 

,FLG16 

,FLG17 

3 


, FLG18 

, F LG 19 

, FLG20' 

, FLG2 1 

, FLG22 

A 


• FLG23 

, FLG2A 

, FLG25 

, FLG26 

, FLG27 

COMMON 


NT 

,NC( 11 ) 

, MN 

, NUN A ( A ) 

, TYPE A ( A ) 

1 


, NER 1 

»NER2 

,NMA 

, NS I GA 

, NS IGC 

2 


, NUNC ( A ) 

,TYPEC(A) 

,NLF{ 11 ) 



COMMON 

IEC , 

NSIGEC, TYPEEC(A), NUNEC(A) 



COMMON 

/P/ 

IPUVEL 





REAL 


MN 


Jr 



COMMON 

/CA/ 

XI (500), 

YK500), 

X2( 500 ) , 

Y2 ( 500 ) , 

DELS (500), 

1 


SINA(5C0) , COS A ( 500 ) 

, XP ( 500 ) , 

YP ( 500 ) 


COMMON 

/TC/ 

RB(500,£),SIG(500,A), A(500), B(500), Z(500 

1 


PHI (500, 

A), 

XN( 500, A) , 


2 


T ( 500, A ) 

, T3( 5C0, A ) 

, NSIG 

, NP, 

NI, SUMV 

3 


, SUMM( A) 





CIMENSICN 

VX( 500, A ) ,VY(5C0,A) 

, VZ ( 500 , A ) 

,T2 ( 500, A ) 



c 

EQUIVALENCE ( VX(l,l>, XN(1,1) ), ( VY(l,l), T(l,l) )» 

1 (VZ(ltl), T3 ( 1 • 1 ) >, ( T 2 ( 1 , 1 ) , T ( 1 » I ) ) 

C 

EQUIVALENCE (VZyVZCP > , ( VX, VXDP ) , ( VY, V YDP ) , ( T2 , T2DP ) , ( T3 , T3DP ) 
D I MENS ICN T2DP(1) , T3CP ( 1 ) , VXCPI 1),VYDP( D.VZDPl I) 

C * START 

IF (FLG08.EG.0) GO TC 10 
C * TITLE FOR MATRIX PRINT 

WRITE (6,150) HEDR,CASE 
WRITE (6,8) 

8 FGRMAT (1H 36H MATRICES A,B,Z BY ROWS * CROSS FLOW //) 

C * READ CROSS SIGMAS 

10 CC 20 N=1 , NS IG 
SUMM(N)=O.C 

2C READ (3) ( S I G < I, N), 1 = 1, NT) 

C * NO. OF MICPCINTS LOGP 

CC 100 1=1, NT 

C * REAC MATRICES A,B,Z 


I 0 7 


READ (10) {A(J),J=1,NT),(B(J),J=1,NT>,(Z(J>,J=1,NT> 

C * NO. OF FLOWS LOOP 

M=0 

CO 70 N=l » NS IG 
MM + 2 
SA = 0 .0 

se=c.o 

sz=c.o 

C * NO. OF ELEMENTS LOOP 

CO 30 J=1,M 
SA=SA+A( J)*SIG( J,N) 

S8=SB+B( J)*SIG( J,N) 

3C SZ = SZ + Z( J )*SIG( J,N) 

C * INITIALIZE UNIFORM OR NON-UNIFORM PARAMETERS 

IF (FLG21.GT.0) GO TC 38 
IF ( N. EG. 1 . AND. FLG17 .L E . G ) GC TO 35 : 

C1=PB( I,M) 

C2 = -RB( I »M-1 ) 

C3=0 .0 
GC TO AO 
35 C1=S INA( I ) 

C2=C0S A( I ) 

C 3 = 1 . • 

GC TO 40 ' . ’ 

38 Cl = 0.0 . 

C2 = 0.0 
C3 = 0.0 

AC IF (FLG12.EG.C) GO TG 45 
C * OPTION FOR Z (PHI) MATRIX SOLUTION 

XN ( I « N ) =5 SA 
PHKI.N) = Y2 ( I ) * SZ 
GC TO .50 

C * REGULAR A MATRIX SOLUTION 

A5 PHI ( I » N ) =» Y 2 ( I ) *SZ 
XN( I ,N)=SA+C2 

50 IF (FLG11.EC.0) GC TO 55 
C * OPTION PERTURBATIONS 

T2 ( I »N ) = S8 
T3(I»N)=SZ 
GC TO 60 

55 T2( I»N)=SB+C1 
T 3 ( I ,N ) = SZ+C3 

60 I F ( FLG21 . GT.O ) GO TO 70 

SUMM(N) =; SUMM(N) ♦ PH(l,N) * Y2(I) * C2 * DEL 
70 CONTINUE 

IF (FLG08.EQ.O) GO TC IOC 
WRITE (6,80) I,(A(J) ,J=1,NT) 
eO FORMAT ( 1HC 13H MATRIX A ROW 16/ ( 1H 10F10.5)) 

WRITE (6,85) I, (B( J) , J=l,NT) 

85 FORMAT ( 1H0 13H MATRIX B ROW 16/ ( IH 10F10.5)) 

WRITE (6,90) I, <Z( J) , J=i,NT) 

90 FORMAT ( 1H0 13H MATRIX Z ROW 16/ (1H I0F10.5H 
ICO CONTINUE 

C * PRINT CROSS FLOW (ON-BOOY) OUTPUT 

130 CC 250 L~1 , NS IG 
KC = L 


10 % 



IF (FLG17.LE.0) KC=L-1 
IF ( FLG21. GT .0 ) GO TO 138 
SUMM(L) = 3.141593 *SUMM(L) 

138 1=1 
J = 1 
M = 1 

N=ND ( M ) 

LCTR=22 

140 WRITE (6*150) HEDR ,C A SE 

150 FORMAT ( 1H1 25X, 26HCCUGLAS AIRCRAFT COMPANY / 

1 28X , 21HLCNG REACH DIVISION III 

2 6X * 10A6, 4X * 10FCASE NO. A6 //> 

IF (FLG22.GT.0) GC TC 175 

IF (L.GT.1.0R.FLG17.NE.O ) GO TO 170 
WRITE (6,160) 

16C FORMAT (1H 27H ON-BODY UNIFORM CROSS FLOW ) 

CO TO 190 

170 IF (TYPEC(KC).GE.O.) GC TO 175 
WRITE (6,172) 

172 FORMAT (1H 31H FLOW GENERATOR * ROTATING BODY ) 

175 WRITE (6,180 NUNC(KC) 

180 FORMAT (IH 35H ON-BODY NON-UNIFORM CROSS FLOW NO. 18) 

190 WRITE ( 6 , 2C0 > 

2CC FORMAT (1H 5X 24H TRANSFORMED COORDINATES // 

1 1 2 X 1HX 13X IF Y 13X 2HT2 12X 2HT3 9X 5HSIN A 

2 6X 5HC0S A 7 X 5HSIGMA 11X 1HN 13X 3HPHI // ) 

210 WRITE (6,220) I , XI ( I ) , Yl ( I ) , X2 ( J » , Y2 ( J ) , T2 ( J , L ) * T3 (J , L ) , 

1 SINA(J) , C 0 S A ( J) , S I G ( J * L ) , X N ( J , L ) , PH I ( J , L ) 

220 FORMAT (IH I3.2F14.7/ 4X 4F 1 4. 7 , 2F 1 1 . 5, 3F14. 7 ) 

1=1*1 
J = J+i 

IF (I.EQ.N) GC TO 230 
IF ( I.LE.LCTR) GO TO 210 
LCTR=LCTR+22 
GO TO 140 
230 M = M* 1 

N=N+ND(M) 

WRITE (6,240) I, XI (I ),Y1(I) 

240 FCRMAT (IH 13, 2F14.7 II) 

1 = 1*1 

I F ( J .GT. NT ) GC TO 242 
GC TO 210 

242 I F ( FLG22.GT .0 )G0 TO 250 

WRITE (6, 244) SUMM(L), SUKV 

244 FORMAT (1H0 10X.14H ACCEC MASS = F12.7, 4X.10H VOLUME = F12.7) 

250 CONTINUE 

CALL BCOUM P ( X2 ( 1 ) , X2 ( NT ) ) • 

CALL BCDUMP (Y2(1),Y2(KT) ) 

CALL BCDUMP (T2DP(1),T2CP(NT) ) 

CALL BCDUMP(T3DP( 1),T3CP(NT) ) 

IF (IPUVEL .EQ. 0) GC TC 252 
LCC = 6500 

CALL PUNCHV ( T2 , NT, NSIG, LOC, CASE ) 

LCC = 6900 

CALL PUNCHV ( T 3 , NT, NSIG, LCC, CASE ) 

252 IF (FLG05.EQ.0) RETURN 


/o? 


C ♦ CFF-BCDY PCINT 

CC 300 I»1,NP 

C * READ MATRICES X,Y,Z 

READ (10) (A(J),J=1, NT), (B( J ) , J=1 , NT ) , ( Z ( J ) , J«1 , NT ) 

C * NC. OF FL CW 

CC 300 N=<1 ,NSIC 
SX=0.0 
SY = 0 .0 
SP=0.0 

C * NC. OF ELEMENTS LCOP 

CC 260 J= 1 ,N T 

' , SX=SX+A( J)*SIG( J,N) ' ' . - 

SY=SY+B(J)*SIG(J,N) 

26C SP=SP+Z(J)*SIG(J,N) 

. VX ( I ,N) =SX v 

■ . PHI (I,N)=YP( I )*SP 

IF (FLG22.C-T.0) GO TC 27C 

IF <FLGll.'GT.O.OR.N.NE.l.OR.FLG17.GTiO) GO TO 2 70 
V Y ( I ,N)=SY+1. 

VZ< I ,N)=SP+1. 

CC TO 300 

C ; - : * PERTUREAT ICN CR NCN-UN I FORM VY,VZ 

27C V Y ( I ,N)=SY 
VZ(l,N)=SP 
• 3CC CCNT INUE 

C ♦ PRINT CROSS FLOW (OFF-BODY) OUTPUT 

33C CC 450 L=1,NSIG 
KC - L 

IF (FLG17.LE.G) KC=L-1 
1 = 1 

LCTR =45 

34C WRITE (fc,15C) HEOR.CASE 

IF (FLG22.GT.0) GO TC 375 

IF' (L.GT.1.0R.FLG17.NE.Q) GO TO 370 

WRITE (6,360) 

36C FORMAT (IH 28H 0FF-8CCY LNIFCRM CROSS FLOW ) 

GC TO 390 • - - 

370 IF (TYPEC(KC).GE.C.) GC TO 375 
WRITE (6,172) 

375 WRITE ( 6, 38G ) NUNC(KC) 

38C FCRMAT (1H 36H OFF-BCCY NON-UNIFORM CROSS FLOW NO. 18) 

39C WRITE (6,400) 

ACC FCRMAT (IH 5 X, 24H TRANSFORMED COORDINATES // 

1 1 2 X 1HX 13X 1HY 13X 2HVX 12X 2HVY 12X 2HVZ 12X 3HPHI //) 

410 WRITE ( 6 , A 20 ) I , XP ( I ) , YP (I ) , VX ( I , L ) , VY< I ,L) , VZ ( I , L ) , PH I ( I , L > 
A 20 FCRMAT ( IH I 3, 6F1A. 7 ) 

1=1 + 1 

IF ( I.GT.NP) GO TO A5C 
IF ( I.LE.LCTR) GO TO A10 
LCTR =LCTR + 45 

GC TO 3A0 . 

A50 CONTINUE 

CALL BCCUMP(XP(1),XP(NP) ) 

CALL BCDUMP( YP( 1 ) , YP(NP) ) 

CALL BCDUMP( VXOP( 1 ) , VXDP(NP) ) 

CALL BCOUMP ( VY0PI1 l,VYCP(NP) ) 

CALL 8C0UMP(VZ0P(1),VZCP(NP) ) 


IF ( 

IPUVEL 

.EQ. 0 ) RETURN 




LCC 

= 7300 





CALL 

PUNCHV 

( VX, NP, NSIG, 

LOC, 

CASE 

) 

LCC 

= 7700 





CALL 

PUNCHV 

( VY, NP, NSIG, 

LOC, 

CASE 

) 


LCC = 8100 

CALL PUNCHV (VZ,NP,NSIG,LOC,CASE) 
RETURN. 

ENC 

lio. 



tIBFTC EXCR 


DECK 


SUBROUTINE EXCRCS 

C*** ***COMPLTE EXTRA CROSS FLOW VELOCITY COMPONENTS AND PRINT 


CCMMCN 

HEDR( 10) 

, C AS E 

,NB 

', NNU 


1 

, FLGO 3 

* FLG04 

, FLG05 

,FLG06 

, FLG07 

2 

, FLGC 8 

,FLGC9 

, FLG 10 

, FLGl 1 

»FLG12 

3 

, FLG1 3 

, FLG 14 

, FLG 15 

, FLGl 6 

, FLGl 7 

A 

, F L G 1 .8 

, FLG 19 

, FLG20 

, FLG2 1 

, FLG22 

5 . 

» F L G 2 3 

* FLG24 

, FLG 25 

,FLG26 

, FLG2 7 

CCU 8 LE 

PRECISION HECP, CASE 




INTEGER 

FLGC3 

,FLGC4 

, FLG05 

,FLG06 

, FLG07 

1 

, FLGp 8 

, FLGG9 

, FLG 10 

,FLG11 

, FLGl 2 

2 

.FLGlV 

' , FLG14 

, FLG 15 

, FLG16 

, FLG 17 

3 

, FLG 1 8 

,FLG19 

, FLG20 

, FL G2 1 

, FLG22 

A 

, FLG23 

, FLG24 

, FLG25 

, FLG26 

, FLG27- 

CCMMCN 

NT;. ( . . 

, N C ( 11 ) 

, MN 

,NUNA ( 4 ) 

, TYPE A ( 4 ) 

1 

, NER 1 

,N ER2 

, NMA 

, N S I G A 

, NS IGC 

2 

, NUNC ( A ) 

, T YPEC ( 4 ) 

,NLF ( 11 ) 



COMMON 

IEC, NSIGEC, 

TYPEEC ( 4 ) , NUNEC ( 4 ) 



CCMMCN 

IPI IPUVEL 





REAL 

MN 





COMMON 

/C4/ X 1 ( 500 ) , YK5G0), 

X2( 500)', 

Y2 ( 500 ) , 

DEL S ( 500 ) , 

1 

SINA(5CC ) , COS A ( 500 ) 

, XP ( 500 ) , 

YP ( 500 )' 


COMMON 

/TC/ R 8 ( 500 

,e»,SIG( 500,4), A (500), B(500), Z(5G0) 

1 

PHI (500,4), 

XN( 500,4) , 


2 

T ( 500, 

4), T3 ( 500 , 4 ) 

, NS I G 

, NP, 

NI, SUMV 


3 , SUMM ( A ) - 

C 

CIMENSICN . . VX't 500-, 4.) , VY'( 500 » 4 ) » VZ.( 500 ,4 ) »T2 ( 5CO * 4 ) - 

c >■ * ■ ‘ •••■-• 

EQUIVALENCE ( VX(1,1>, XN<1,1) ), < VY(1,1), T { 1 , 1 » ), 

1 (VZ(.1,1,>, T 3 ( 1,1) >, <T2(l,l), T { 1 , 1 ) ) 

c . , •: • r . :■■■• •• ••• 

REWIND 8 

IF (FLG08.EC.0) GC TC 10 
C«*« ***TITLE FOR MATRIX PRINT 
WRITE ( 6, 150 ) HEDR.CASE 
WRITE (6,8) 

e FORMAT (1H 42H MATRICES A,H,Z 8Y ROWS * EXTRA CROSS FLOW // ) 
C*** ***READ EXTRA CROSS SIGMAS 

10 CC 20 N = 1 ,N S I G - 

2C READ (3) ( SIG(I,N), I = 1,NT ) 

C*** ***N0. OF MIDPOINTS LOOP 

CC 100 I - 1 , NT 
C*** ***RE AC MATRICES A, B , Z 

C*** 44 4Y0U MUST SOLVE POTENTIAL MATRIX FOR EXCROS 

READ (8) ( A ( J ) , J = 1 ,NT )', ( B (J),J = 1,NT ), ( Z(J),J = 1,NT ) 
C4«* ***N0. OF FLOWS LOOP 

M = 0 ' : . • 

CC 70 N =5 1 , NS IG 



M = M ♦ 2 
SA = 0.0 
SB = 0.0 
SZ = 0.0 

C*** ♦♦♦NO. OF ELEMENTS LCCP ' 

CC 30 J - 1 * NT 

SA = SA ♦ A { J ) ♦ SIG(J,N) 

SB * SB 4 B(J) * SIG(JfN) 

3C SZ = SZ i Z( J) * S IG ( J T N ) 

AC T2( I *N) =5 SB 

T3 (I »N) = SZ 
X N ( I * N > n SA 

PH I ( I , N ) = Y2( I V * SZ / 2.0 
7C CONTINUE^- :t 

IF (FLG08.EG.C) GO TO IOC 
WRITE 16,80) I, ( A ( J ) , J = 1,NT) 

BO FORMAT ( 1HQ 13H MATRIX A ROW 16/ ( ltt I0FI0.5) ) 

WRITE (6,85) I, (B(J),J = 1,NT) 

65 FORMAT (1H0 13H MATRIX B ROW 16/ (IH L0FI0.5) ) 

WRITE (6,90) I, ( Z(J),J = I, NT) 

90 FORMAT ( IH9 I3H MATRIX Z ROW 16/ ( IH I0FL0.5) ) 

ICO CONTINUE 

C**« ♦♦♦PRINT EXTRA CROSS FLOW (CN BODY) OUTPUT 
130 CC 250 L = l.NSIG 
KEC = L 
I = I 
J = 1 
M ■ 1 
N * ND(M) 

C*** ***** IS THE BODY NUMBER 

C*** ♦♦♦N IS THE NUMBER CF POINTS ON BODY M 

LCTR =22 

1 AO WRITE (6,150) HEDR,CASE 

I5C FORMAT (1H1 25X, 26HCCUGLAS AIRCRAFT COMPANY / 

1 28X , 21HLCNG BEACH DIVISION III 

2 6 X , 10 A6 , AX, 10HCASE NO. A6 //) 

IF (FLG22.GT.0) GO TC 160 

WRITE (6, 155 )NUNEC(KEC ) 

155 FORMAT ( A1H CN-BOOY NON-UNIFORM EXTRA CROSS FLOW NO. 18) 

C-0 TO 190 

160 WRITE (6,162) 

162 FORMAT (68H ON BODY GENERATED (RESEP) BOUNDARY CONDITIONS 
1A CROSS FLOW) 

190 WRITE (6,200 

2CC FORMAT (IH 5X 2AH TRANSFORMED COORDINATES // 

1 12X 1HX 13X lFY 13X 2HT2 12X 2HT3 9X 5HSIN 

2 6X 5HC0S A 7X 5HSIGMA I1X IHN 13X 3HPHI // ) 

210 WRITE (6,220) I , XI ( I ) , Y1 ( I ) , X2 ( J ) , Y2 ( J ) , T2(J,L),T3(J 

1 SINAI J),CCSA( J) ,SIG( J,L) ,XN( J,L), PHI (J,L) 

22C FORMAT (IH 13.2F1A.7/ AX AF 1 A . 7 , 2F 11 .5 , 3F 1 A .7 ) 

I = t + l 
J = J + 1 

IF (I.EQ.N) GO TO 230 . 

IF ( I.LE.LCTR) GO TO 210 
LCTR = LCTR ♦ 22 
GO TO 1A0 


ux 


EXTR 

A 

L) , 



2 30 M = M + 1 

N = N + NO ( M ) 

WRITE ( 6 , 2 AO ) I , XIII), V1III 
2 AO FORMAT (1H I3.2F1A.7 // ) . .. 

1=1 + 1 

IF ( J.GE.NT ) GO TO 250 
GO TO 210 
250 GCNTINUE 

***THIS IS WHERE THE CALL FOR PUNCHED OUTPUT WILL GO 
252 IF ( FLG05 . EC .0 ) RETURN 
0*** ***OFF BODY POINTS 
CO 300 I = 1 » NP 
C<«* ***REAC MATRICES X,Y,Z 

READ (8) ( A ( J ) , J = 1 » NT ),(B(J),J = 1,NT), ( Z ( J ) , J = 1,NT ) 

CG 300 N = 1 , NS I G 
SX = 0.0 
SY =0.0 
SP = 0.0 

C*** ***NUMBER OF ELEMENTS LOOP 
CO 260 J = 1 » NT 
SX. = SX + A( J) * SIG (Jr N) 

SY = SY -F B(J) * SIG (JtN) 

260 SP = SP ♦ Z(J) * SIG(J.N) 

VX ( I r N ) = SX 
VY(I,N) =? SY 
VZ(I,N) n SP 

PHIU.N) = YP ( I I * SP / 2.0 
3CC CONTINUE 

O** ** APR I NT EXTRA CROSS FLOW (OFF-BODY) OUTPUT 

330 CC A 50 L = l.NSIG 
KEC = L 
1 = 1 
LCTR = A5 

3A0 WRITE (6,150) H E OR , C A S E 
IF (FLG22.GT.0) GO TO 355 
WRITE(6,35C) NUNEC(KEC) 

350 FORMAT . ( A 3H OFF BODY NON-UN IFORM EXTRA CROSS FLOW NO. 18) 

GC TO 390 
355 WRI TE( 6,357 ) 

357 FORMAT (68H OFF BODY GENERATED (RESEP) BOUNDARY CONDITIONS EXTR 
1A CROSS FLOW) 

390 WRITE ( 6 , AGO ) 

ACO FORMAT (1H 5X, 2AH TRANSFORMED COORDINATES // 

1 12X 1HX 13X 1HY 13X 2HVX 12X 2HVY 12X 2HVZ 12X 3HPHI //) 

A 10 WRITE (6, A20) I , XP < I ) , YP ( I ) , VX ( I , L ) , V Y ( I , L ) , VZ ( I , L ) , PH I ( I, L ) 

A2C FORMAT (1H 13, 6F1A.7) 

1=1 + 1 

IF ( I.GT.NP)GO TO A5G 
IF (t.LE.LCTR) GO TO AlO 
LCTR = LCTR + A5 
GO TO 3A0 
A50 CONTINUE 

C.*** #**THIS IS WHERE THE CALL TG PUNCHED OUTPUT OFF BOOY WILL GO 
RETURN 
END 


H3 



COMBYN ■ - -J> 


ilBFTC COMBYN DEBUG, DECK 

C THE MAIN PROGRAM FOR APPROACH 5 COMBYN 
C 

COMMON /MONOF/ 

COMMON /NIN/ XOFF 1200 ) » YOFF ( 200 ) »NPMIN,NCLQ» NCHI 

COMMON /RDOUTI/ X0N1 400 ) ,YON< 400 ) , NSPE! 10) , NSPB < 10 ) , XRI , NHUBMX.NTM 
1IN,NSPLT,YWING 

COMMON /R0GUT2/ T! 400 , 2 ) ,VYAX! 200i 2) , VYCR! 200 ) , V2 ! 400) , V3! 400 > ,VZC 
IR(200) 

COMMON /RD0UT3/ VXAX ( 200 ,2 1 , VXCRI 200 1 

COMMON /RC0NT1/ VC, V INF, ALFAF,TTOTAL,ELMD»VA,PT 

COMMON /C0UT1/ QCA.PTC, PSPTC I,PI0180,ATOTAL,GRHO 

COMMON /C0UT2/ VINFP,RHOTOT,VIC 

COMMON /RD0UT4/ NTHETA, THETA! 10) ,XTEST! 10) 

COMMON /GETOUT/ VMAG! 3 ) , AL IL ,BLIL,CLIL 
COMMON /TOUT 1/ S INTH , COS TH, OMEGA . 

COMMON /RC0NT2/ PSTAT , TSTAT, WDOT, NX.KND, YRIHUB, YRI SHR,UT IP 
COMMON /RSAVE/ XDUM1 400 ) ,YDUM! 400 1 , X AFFI 200 I , YAFF ( 200) 

1 , MO, JA, IR,NRUNN0,M02, JA2, IR2,NRUN02 
2 CALL READS 

VSAVE a VINF 

IF (VINF.EQ.O.O) GO TO 4 

VINF=VINF*!1.0-.2*(VINF/AT0TAL)**2)**2.5 
4 VCS AVE*VC 

vc=«vic ■ ■ ■ ' ‘ 

CALL GETABC 
VC*VCSAVE 
VINFP=VINF 
VINF*VSAVE 

WRITE (6,8) VMAG! 1),VMAG!2),ALIL,BLIL,CLIL,VINFP 

CALL AVERV 

REWIND 2 

REWIND 3 

DO 6 N=1,NTHETA 

WRITE ! 6 , 10 ) N »NTHET A 

READ ! 3) WDOTT , VICT , 

WRITE 16,12) THETA!N) , WDOTT, VICT, VMAG13) 

THETA! N)»THETA!N)*PI 0180 
SINTH a SIN!THETA!N) ) 

CSINTH*CLIL*SINTH 
COSTH*COS! THETA! N)) 

CCOSTH=CLIL*CQSTH 
OMEGA*UTI P/YRISHR 
CALL ONOFF 
6 CONTINUE 

GO TO 2 

C**4** 

C*** FORMATS 
C 

8 FORMAT 197H VI V2 A 

IB C VINFP /5X, 1P6E14.3) 

10 FORMAT ! 1H0»4X* 12, 4H OF ,I2,7H THETAS/lHO) 

12 FORMAT !3X,8HTHETA « ,E12.5,13H WDOTT * ,IPE12.5,12H VICT 
1= , 1 PE12. 5 , 10H V 3 = t 1PE12.5) 

END 



O' *• 


$IBFTC SINTP. 

SUBROUTINE SINTP (Z,W,N,X1,Y1) 

01 MENS ION X( 200 ) , YI20O), Z<1), HC1) 

DO 2 1*1, N 
XUI-ZII) 

2 Ycn=wm 

CALL SORTXY. <X,Y,N> 

c ' • . . " 

DO 4 1=1, N 
K=I 

IF (Xl.GT.X(I)) GO TO 4 

IF (Xl.EQ.X(I)) GO TO 6 

IF (Xl.LT.X(I)) GO TO 8 

continue 

Y1=Y(K) 

GO TO 10 
8 IF (K.EQ.l) GO TO 12 

IF (K.EQ.N) K=N-1 

IF (X(K).EQ.X(K+1)) K=K-1 

Wl=CXl-X(K))*{Xl-X(K + in/IX(K-n-X{K)>/CXCK-l)-X(K+l)) 
W2=*CXl-X(K-in*<Xl-XIK+l»)/(X(K)-X(K-in/IX(IO-X(K+m 
WB=IXl-X(K-l)»*(Xl-XfKn/CXCK+l»-X(K-in/(X(K+l)-X(K) ) 
Y1=Y(K-1J*H1+Y(K)*W2*Y(K+1I*W3 
10 RETURN 

12 Yl=0.0 

RETURN 
ENO 



NOUOU 


S.IBFTG INTPL. DEBUG, DECK 

SUBROUTINE INTPOL <L. J,XI, I FL AG, VX, VRES , BETA, ALPH ) 

C***** 

C*** THIS SUBROUTINE INTERPOLATES AND DIFFERENTIATES 

£***«* 

COMMON /CNOUT/ VRESONI4O0) ,VP(400) »BETAON( 400) 

COMMON /GEABC/ YI 

COMMON /RD0UT1/ XON( 400 > ,YON( 400 ) , NSPEUO) ,NSPB < 10 ) , XRI , NHUBMX,NTM 
II N, NSPLT , YWI NG 

COMMON /RD0UT2/ T{ 400 , 2 ) ,VYAX( 200, 2) , VYCRI 200 ) , V2 ( 400) , V3( 400 ) , VZC 
1RC200) 

DIMENSION V(400) , 8(400) 

EPS=1.0E-6 
M= J— 1 
N= J+l 
A=1 .0 
DO 2 K=M, N 
XDI F=XI— XON ( K ) 

IF (XDIF.EQ.O.O) XDI F=EPS 
A=A*XDIF 
CONTINUE 

IF THE REAKE X EQUALS THE ON BODY X THEN SET INTERPOLATED VALUES 
TO THE VALUES ON BODY 

IF (ABS(XI-XON< J) ).LE.1.0E-6) GO TO 20 
DO 4 K=M, N 
B(K)*l.O 
DO 4 LL=M,N 
IF (LL.EQ.K) GO TO 4 
B(K)=B(K)*(XON(K)-XON(LL )) 

4 CONTINUE 

YI»0.0 
DUM=0.0 
VINT=0.0 
DO 12 I I*M,N 
XDIF»XI-XON(II ) 

IF (XDIF.EQ.O.O) XDI F=EPS 
IF (L.EQ.3) GO TO 6 
IF ( IFLAG.GT • 1 ) GO TO 8 
V ( 1 1 )*T( 1 1 ,L ) 

GO TO 10 

6 V( 1 1 )*V2( II) 

GO TO 10 

8 V ( I I )-VRESON( II) 

10 YI*YI+( A*YON( I I))/(XDIF*B( II )) 

VINT-VINT+(A*V(II))/(XDIF*B( II)) 

IF ( IFLAG.EQ.l) GO TO 12 
V(II)=VP(II) 

DUM=DUM+( A*V (II) )/(XDIF*B( II)) 

12 CONTINUE 



IF UFLAG.EQ.il GO TO 16 

BET A=0.0 

PS0P=0.0 

00 14 II*M»N 

XO I F=XI-XON< 1 1 I 

IF ( XOIF.EQ.O.O) XOI F = EPS 

BETA®BETAUA*BETAON( 111 )/<XOIF*B( III) 

14 CONTINUE 

16 JK*J 

18 A0=X1-X0N( JK-1) 

BD=XON< JKI-XI 
PO® AD*( AO+BO I 
P1=-(AD*BD) 

P2 = ( AD+BO) *BD 
A0=— BD 
A1=AD-BD 
A2= AD 

0Y*( AO*YON( JK-1) I/P0+(A1*YI )/Pl+(A2*Y0N( JK) I/P2 
ALPHA=ATANIDY I 

ALPH=ALPNA/( 3. 14159265/180. I 
VX=VINT*COS< ALPHAI 
VRES=VINT 

IF (IFLAG.EQ.2) VX=OUM*COS ( ALPHA) 

RETURN 

20 IF (L.EQ.3) VINT=*V2< J) 

VINT*TU#L) 

IF ( IFLAG.GT.l) VINT »VRE$0NI J I 
YI=YON(Jl 

IF (IFLAG.NE.l) DUM-VPUI 
BET A=8ETA0N( J I 
JK=J-1 
GO TO 18 
END 


1 17 



$IBFTC GTABC. DEBUG, DECK .. . , ; • : . 

SUBROUTINE GETABC • • • 

C*** COMPUTES VI , V2 , V3 , A ,8 , C FROM INPUT PARAMETERS 

COMMON /ROOUT1/ XGNC 400 I ,YQN(40Q ) ,NSPE( 10 l »NSPB( 10 ) »XRI ,NHUBMX,NTM 
1IN,NSPLT, YWl NG 

COMMON /RDOUT 2/ T< 400 ,2 ) ,VYAX< 200, 2» , VYCRC 200) ,V2( 400) , V3( 400) ,VZC 
1R ( 200) 

COMMON /NIN/ XOFFC 200 ) » YOFF ( 200 ) , NPMIN»NCLO»NCHI ' 

COMMON /RD0UT3/ VXAX I 200 ,2 I , VXCRI 200 ) 

COMMON /RCONT 1/ VC,V INF, ALFA F, TTOTAL,ELND,VA,PT 
COMMON /GETOUT/ VMAG C 3 ) , AL IL ,BL IL, CL IL 
COMMON /GEABC/ YI 
DIMENSION VXAXH( 2 ) , VX AXS<2) 

PI 0180*3. 14159265/180. 

ALFAF=ALFAF*P 10180 

DEBUG! CVXAXC I, Jl, 1=1, 200), J=l,2> 

DEBUG! VXCRI II, I =1,200) 

C***** 

C*** COMPUTE VI , V2 , V3 

IF ( XOFF! NCLO) .LT.XON i 1 ) ) GO TO 6 

C 

C ... SEARCH ON HUB COUNTING BACKWARDS • 

c 

J=NHUBMX 

2 IF (XON( J).LT.XOFF(NCLO) I GO TO 4 

J=J-1 
GO TO 2 
4 J=J+l 

XH=XOFF ( NCLO ) '•> ' 

I FLAG* l 

CALL INTPOL !i, J,XH, IFLAG, VX, DUM, DUM, DUM) 

VXAXH!1)*VX 

CALL INTPOL C2, J,XH, IFLAG, VX, DUM, DUM, DUM) 

VXAXHI 2 )=VX 

CALL INTPOL ( 3, J , XH, I FLAG, VXCRH, DUM, DUM, DUM ) 

YH=Y I 
GO TO 8 
6 YH*0.0 

VXAXH! 1 1=0.0 
VXAXH!2)=0.0 
VXCRH=0.0 

c*#*** 

C*** SEARCH ON SHROUD COUNTING FORWARDS 
8 K=NHUBMX+ I 

10 IF CXONtKI.LT. XOFFCNCHI)) GO TO 12 

K=K+ 1 
GO TO 10 
K=K- 1 
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XS-XOFFINCHI ) 

I FLAG 3 ! 

CALL INTPOL (1, K»XS. IFLAG, VX*DUM,DUM,DUM) 

VXAXS( 1 )*VX 

CALL INTPOL <2,K,XS, IFLAG, VX.DUM, DUM.DUH) 

VXAXS(2)*VX 

CALL INTPOL <3,K,XS, IFLAG, VXCRS,DUM,DUM,DUM) 

YS*Y I ' 

ILOW*NCLO+l 
IHIGH=NCHI— 1 
C 

C AXIAL COMPONENT VELOCITY *** AXISSYMETRIC SOLUTION 
C 

DO 16 L*l,2 

SUM=YH*VXAXH(L)*( YOFF (NCLO )-YH)+VX AX (NCLO, L )*YOFF ( NCLO)*! YOFF I NCLO 
l+D-YH) 

DO 14 I=ILOW,IHIGH 

SUH=SUM+VXAXU,L)*YOFF<I)*(YOFF(I + i)-YOFF(I-l)) 

14 CONTINUE 1 

SUM=SUM+YOFF (NCHI ) *VXAX( NCHI, L )*( YS-YOFF( NCHI-1 ) )+(-1.0)*YS*VXAXS( 
1L ) *( YS-YOFF ( NCHI ) ) 

VMAG (L )*SUM/ ( YS**2-Yh**2 ) 

16 CONTINUE 

C 

C AXIAL COMPONENT CROSSFLOW VELOCITY SOLUTION 

C 

SUM* YH*VXCRH*( YOFF ( NCLO ) -YH 1 +VXCRI NCLO )*YOFF ( NCLO) *( YOFF ( NCLO+ll -Y 
1H) 

DO 18 1*1 LOW , 1 HIGH 

SUM*SUM+VXCR(I)*YOFF( I)*(YOFF( I>1)-Y0FF( 1-1) > 

18 CONTINUE 

SUM=SUH*YOFF(NCHI)*VXCR( NCHI )*( YS-YOFFI NCHI-1 ) )+(-l.O)*YS*VXCRS*( Y 
1S-YQFFINCHI ) I 
VMAG(3)=SUM/(YS**2-YH**2) 

CLI L*VINF*CQS( ALFAF) 

ALIL=(VC+VINF*SIN(ALFAF)*VMAG(2J )/ ( VMAGI U-VMAGI 2) ) 

BL I L=( VC*V INF*SI N( AL FAF ) *VMAG( 1) ) / ( VMAG( 2 ) — VMAGI 1)1 

ALFAF=ALFAF/PI0180 

RETURN 

END 





oo ouo <ni >r 0'0 


SI8FTC VB ART DECK 


APPROACH 5 

SUBROUTINE VBARIT (VBAR, ATOTAL,RHQTOT,RHOBAR ) 

TO SOLVE VBAR COMP ITERATIVELY 
VCRIT=ATOTAL/SQRT( 1. 2 ) 

1=0 - ■■ - 

VGUES=V8AR 

VGUESA=( VGUES/ATOTAL ) **2 
A=l.0-.2*VGUESA 
B= A-VGUESA 

VC0MP=(VBAR-A**2.5*VGUES)/(A**1.5*B)+VGUES 
IF ( ABS ( ( VCOMP-VGUES ) /VCQMP ) YLT • • 0001 ) GO TO 4 
1 = 1+1 

IF (VCOMP.GE.VCRIT) VC0MP=.5*( VGUES+VCRIT) 

VGUES=VCCMP 

IF ( I.GT.20 ) GO TO 4 

GO TO 2 

RHOB AR=( 1 .0-. 2*( VCOMP/AT OT AL >♦*2 )**2.5*RHQTOT 
IF (I.GT.20) WRITE (6,6) VBAR,VCOMP,RHOBAR 
RETURN 

FORMAT ( 1H0 , 34HI EXCEEDS 20 ITERATIONS FOR RHOBAR, 5X»7HVBAR = ,1PE 
110.3, 2X.8HVC0MP = , l PE10 .3 , 2X.9HRH0BAR * ,1PE10.3) 

END 
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$IBFTC READS. DEBUG* DECK 
SUBROUTINE READS 

C***** 

C**4 THIS SUBROUTINE READS ALL INPUT 
c***«* 

EQUIVALENCE (T,TRD), ( VXAX.VXAXRO) , ( VYAX,VYAXRD > 

DIMENSION TRD(l), VXAXRD(l), VYAXRDI 1 ) • E0DDI400), TITLEI12) 

COMMON /RSAVE/ XDUM( 400 ) ,YOUM( 400 ) ,XAFF ( 200 ) , YAFF ( 200 ) 
i » MO , JA, I R , NRUNNO, M02 «JA2t IR2, NRUN02 
COMMON /NIN/ XOFF( 200 ) , YOFF ( 200 ) ,NPMIN,NCLO,NCHI 

COMMON /RD0UT1/ XON( 400) ,YON ( 400 ) , NSPE ( 10) ,NSPB( 10) ,XRI .NHUBMX, NTM 
1 1 N# NSPLT » YWING 
COMMON /WRT/ KSKIP, NT(2),NP(2) 

COMMON /RD0UT2/ T ( 400, 2 ) ,VYAX( 200, 2 ) , VYCR ( 200 ) , V2 ( 400 ) , V3 ( 400 ) , VZC 
1RI200) 

COMMON /RD0UT3/ VXAX (200,2 ) ,VXCR( 200 ) 

COMMON /RD0UT4/ NTHETA,THETA< 10) yXTESTI 10) 

COMMON /RC0NT1/ VCyVINF, ALFAF,TTOTAL,ELND,VA,PT 

COMMON /RC0NT2/ PSTAT , TSTAT, WOOT, NX, KND, YRIHUB, YRI SHRyUTIP 

C***** 


C READ NT(1) = NUMBER OF ON-BOOY POINTS FOR CLOSEO BODY SOLUTION 

C NT( 2 ) = NUMBER OF ON-BODY POINTS FOR OPEN-END SOLUTION 

C NP(1) = NP( 2) - TOTAL NUMBER OF OFF-BODY POINTS 

C NID - NUMBER OF EOD 1.0. CARDS 

C KSKIP * 0 FOR 1 CASE OF COMBYN 

C = 1 FOR SUCCESSIVE CASES USING THE SAME EOD OUTPUT 

C N4S0L * 0 THREE (3) SOLUTIONS FROM EOD 

C < 2 FOR STREAMLINES ,1 FOR CROSSFLOW ) 

C =1 FOUR (4) SOLUTIONS FROM EOD 

C <2 FOR STREAMLINES, 2 FOR CROSSFLOW ) 

C NSPLT = NUMBER OF SPLITTERS (NOISE SUPPRESSION DEVICES ) 

C 

C 

C NSPB = RIGHT MOST POINT ON THE SPLITTER 

C NSPE = LEFT MOST POINT ON THE SPLITTER 

C 

C ***** THE FIRST SPLITTER IS THE ONE CLOSEST TO THE HUB 

C ANO THE LAST SPLITTER IS THE ONE CLOSEST TO THE SHRO 

C 


C***«* 

READ (5,30) TITLE 

READ (5,32) (NT( I ) ,NP( I ) , 1=1 ,2 ) ,NI D, KSKIP, N4S0L, NSPLT 
NPMIN=NP(1) 

NTMIN«NT(2) 

IF (NSPLT. NE.O) READ (5,32) (NSPB( I ) , NSPE ( I ) , I=*l» NSPLT ) 

READ (5,34) VC, V INF, ALFA F, TTOTAL,ELND, YWING»UTIP,VA,PT 

READ (5,34) PSTAT, TSTAT, WOOT 

READ (5,32) NTHETA,NCLO» NCHI , NX, KND 

READ (5,34) (THETA( I ) , I*1,NTHETA ) 

READ (5,34) (XTEST( I ) , I = 1,NX ) 

READ (5,36) XRI , YRIHUB, YRISHR, NHUBMX 
DEB UG( NSPB ( I ) , NSPE ( I ), 1=1, NSPLT) 

C**«** 

C**« IF KSKIP = 0 , READ DATA PUNCHED FROM EOD 

c***«* 


1*1 



IF (KSKIP.NE.O) GO TO 20 
READ <5,381 MO, JA, IR,NRUNNO 
DO 18 L=l ,2 
I LOGN= 1+4004 (L-l) 

IHICN= ILCON+NT ( L )-l 
NTL = NT { (_ ) 

IL0=1+200*(L-1) 

IHI=ILO+NP(L )— 1 
NPL=NP(L) 

IF (L.EQ.l) GO TO 4 
IF (NID.GT.l) GO TO 2 
M02=M0 
JA2-JA 
I R2= IR 

NRUN02*NRUNN0 
GO TO 4 

2 READ (5,38) M02, JA2, IR2, NRUNC2 

C*** READ OUTPUT FROM EOD (BINARY RECORDS) 

4 CALL BCREAD ( XON ( 1 ) , XON ( NTL ) ) 

CALL BCREAD (YON( 1), YCN{ NTL ) ) 

CALL BCREAD (TRD( I LOON ) , TRD( IHION) ) 

CALL BCREAD ( XOFFI 1 ) ,XOFF( NPL ) ) 

CALL BCREAD ( YOFF( 1 ) , YOFF( NPL ) ) 

CALL BCREAD (VXAXRO( ILO ) ,VXAXRD( IHI ) ) 

CALL BCREAD (VYAXRD( ILO) ,VYAXRO( IHI ) ) 

CALL BCREAD ( EODD( 1 ) , EODD( NPL ) ) 

IF (L.EQ.2) GO TO 6 

CALL BCREAO ( XON ( 1 ) , XON( NTL ) ) 

CALL BCREAD (YON( 1), YCN(NTL) ) 

CALL BCREAD (V2( ILOON ) ,V2( IHION) ) 

CALL BCREAO ( V3( ILOON ) , V 3( I H ION ) ) 

CALL BCREAD ( XOFF ( i ) , XOFF( NPL ) ) 

CALL BCREAO ( YOFF ( 1 ) , YOFF( NPL ) ) 

CALL BCREAD ( VXCR( ILO) ,VXCR( IHI ) ) 

CALL BCREAD (VYCR( ILO ) , VYCR< IHI ) ) 

CALL BCREAO (VZCR(ILO),VZCR( IHI)) 

GO TO 12 

6 IF (N4S0L.EQ.0) GO TO 18 

DO 8 1=1,4 

CALL BCREAO (EODD( 1 ) , EODD( NTL ) ) 

8 CONTINUE 

00 10 1=1,5 

CALL BCREAO ( EODOt 1 ) , EODD( NPL ) ) 

10 CONTINUE 

12 DO 14 1=1, NTL 

XOUM ( I )=XQN( I ) 

14 YOUM( I )=YON( I ) 

DO 16 1=1, NPL 
XAFF ( I )=XOFF ( I ) 

16 YAFF ( I )=YOFF < I ) 

18 CONTINUE 

20 WRITE (6,28) TITLE 

WRITE (6,40) MO, JA,1 R,NRUNN0,M02, JA2, IR2*NRUN02 
CALL CONST 



DO 22 1=1 tNTMIN 
XON( I )=XDUM{ I J/ELND 
22 YON( I)=YOUM( Il/ELNO 

DO 24 1=1 ,NPMIN 
XOFF ( I )=XAFF ( I ) /ELND 
24 YOFF(I)=YAFF(I ) /ELND 

00 26 1=1, NX 

26 XTEST( n = XTEST( n/ELND 
RETURN 
C 

C FORMATS 

C 

C 

28 FORMAT < 1H1 , 10X, 30HC0MPRESSI BLE COMBYN APPROACH 5,10X,12A6) 

30 FORMAT C12A6J 

32 FORMAT <20141 

34 FORMAT I10F8.3) 

36 FORMAT <3F10.2,I4) 

38 FORMAT <42X,3I2,I6) 

40 FORMAT <IH0/25H BASEO ON BASIC DATA FROM, 13 , 1H/ , 12, 1H/, I 2,8H RUN N 

10 • , I 6, 4H AND, 13, I H/, I2,1H/,I2,8H RUN NO., 16/) 

END 


/ 23 



SIBFTC CONST. DEBUG, DECK 

SUBROUTINE CONST 
C 

C THIS SUBROUTINE CALCULATES MOST OF THE CONSTANTS USED IN COMBVN 
C 

COMMON /NIN/ XOFFI 200 ) , YOFF ( 200 ), NPMIN, NCLO, NCHI 

COMMON /RCCNT2/ PSTAT ,TSTAT, WDDT ,NX,KND, YRIHUB,YRI SHR, UT I P 

COMMON /RCONTi/ VC, V INF, AL FAF,TTOTAL , ELND, VA ,PT 

COMMON /C0UT1/ QCA, PTC , PSPTC I , P 10180 , ATOTAL , GRHO 

COMMON /CQUT2/ V INFP , RHOTOT , V IC 

COMMON /WRT/ KSK IP ,NT ( 2 ) ,NP( 2 » 

COMMON /R00UT4/ NTHET A , THETA 1 10 » , XTE ST ( 101 

COMMON /ROOUTl/ XONt 4C0 ) ,YON( 400 ) , NSPE ( 10) ,NSPB( 10 ) , XRI ,NHUBMX, NTM 
1 I N , NSPLT , YWING 
REAL MC,MA,MINF 
PI=3. 14159265 
R2 1568=17 15. 63 
G=32.174 
PI0180=PI/180. 

IF (PSTAT. NE. 0.0. AND. TSTAT.NE. 0.0) GO TO 2 
IF (PT.EQ.O.O) PT=21 16. 22 
IF (TTOTAL.EQ.O.O) TT0TAL=5 1 8.67 
ATOT AL=49.*SQRT ( TTOT AL ) 

CAT0T=1.0-.2*(V INF/ ATOTAL) **2 

PSTATC=PT*CAT0T**3.5 

PTC=PT 

RH0T0T=PT/(R21568*TT0TAL ) 

TST AT=TTOT AL*CATOT 
RH0ST=PSTATC/(R21568*TSTAT) 

PSTAT=PT-.5*RH0ST*VINF**2 
ASTAT=49.*SQRT (TSTAT ) 

GO TO 4 

2 ASTAT=49.0*SQRT( TSTAT) 

PSTATC*PSTAT 

RHOST=PSTAT/(R21568*TSTAT) 

AMI NF=VINF/AST AT 

CAM I NF=i.0>.2*AMINF**2 

PT=PSTAT+.5*RH0ST*VINF**2 

PTC=PSTAT*CAMIMF**3. 5 

TTOT AL=TSTAT*CAM INF 

RH0T0T=PT/(R21568*TT0TAL) 

ATOT AL=49.*SQRT ( TTOT AL ) 

4 IF (HOOT. EQ. 0.0) GO TO 6 

AC=PI*(YRISHR**2-YRIHUB**2)/144. 

VIC=WDOT/(G*RHOTOT*AC) 

V I CC= ATOTAL/ 1.728 

C***»* 

C*** FOR 0. BREUNLIN TAKE OUT FOLLOWING THREE! 3) CARDS 8/30/71 

C I F ( V IC.LE • VI CC ) GO TO 25 

C VIC = vice 


/ay 



c 


WOOT * RHOTOT*VICC*AC*G 
CALL VBARI T ( V IC» ATOT AL » RHOTOT »RHOC ) 

VC*WOOT/ C G*RHOC*AC > 

6 IF (VA.EQ.O.O) VA=VC 

C*** TESTS FOR NORMALIZING PARAMETERS ( ELND ) 

C*** IF KNO = -1, ELNO =YRISHR 

C*** 0» SET ELND = 1.0 AND SKIP NONDI MENS IONAL CALCULATIO 

C*** 1, ELND = YRISHR - YRIHUB 

C*** 2, USE READ IN VALUE OF ELND 

C*** 4,5,6 USE VA FOR NONDIMENS IONALI ZING VELOCITIES 

IF (KND.EQ. 0) GO TO 8 
VCA=VC 

IF (KND.GE.4) VCA=VA 

WRITE (6, 28 ) VC, VINF , VA, VCA, PT » TTOTAL 

VC^VC/VCA 

VA=VA/VCA 

VI NF=V INF/ VCA 

PT=1 .0 

TT0TAL=TT0TAL/(VCA**2) 

8 IF ( KND.EQ.— l.OR.KND. EQ.4) ELND=YRISHR 

IF (KND.EQ. 1. OR. KND.EQ. 6) ELND=YR I SHR-YR I HUB 

IF ( KND. EQ.O.OR. KND.EQ. 5 > ELND=1.0 

XR I=XRI/ELND 

YRIHUB=YR IHUB/ELND 

YRI SHR^YR ISHR/ELND 

RTTOT=R21568*TTOTAL 

GRH0=32. 174*PT/RTT0T 

C102RT=.5/RTTQT 

IF ( PSTAT o NE .0.0 ) C102RT=.5*RH0ST/PT 

VCOVA=VC/VA 

V IOVA=VINF/VA 

VNFOVC=VINF/VC 

VFOA T= VINF/ ATOT AL 

VC0AT=*VC/AT0TAL 

VAOAT=»VA/ATOTAL 

C0N1 3 »1.0-.2*VC0AT**2 

C0N2=1.0-.2*VF0AT**2 

C0N3=1.0-.2*VA0AT**2 

RS0RTF*CCN2**2.5 

RS0RTA=CGN3**2.5 

RS0RTC*CCN1**2.5 

IF (WDOT.EQ.O.O) VIC = VC*RSORTC 

VS0NIC=AT0TAL/1.728 

VSGNCC*ATOTAL/SQRT( 1,21 

PSPTC»1.0-C102RT*VC**2 

PSPTIF“1.0-C102RT*VINF**2 

PSPTCI*RS0RTF*C0N2 

PSPTCC*RS0RTC*C0N1 

PSPTCA=RS0RTA*C0N3 

PSPTA=l.0-C102RT*VA**2 

MINF=VF0AT/(C0N2**.5) 

MC=VC0AT/(C0N1**.5) 

MA=V AOAT/ ( C0N3**. 5 ) 

QINF=PT*( 1.0-PSPTIFI 


I as 




c 

c 

c 

c 

10 


12 

14 

16 

18 

20 

22 

24 


26 

28 

30 

32 

34 


QCINF=PTC*<.7*VFOAT**2*RSORTF) 

QC=PT*< 1.0-PSPTC ) 

QCC=PTC*< .7*VCOAT**2*RSORTC } 

QA=PT*< 1.0-PSPT A ) 

QCA=PTC*( •7*VA0AT**2*RS0RTA1 
tHETC=TT0TAL/518.67 
0EL= PTC/2116.22 
HBTPR=YRIHUB/YRI SHR 
WRITE (6,10) 

WRITE <6,12) VC, MC»QC * QCC* PSPTC, PSPTCC »RSORTC 
WRITE <6,141 VA,MA,QA,QCA,PSPTA, PSPTCA,RSORT A 
WRITE 16,16) VINFjMINF*QINF,QCINF,PSPTIF,PSPTCI» RSORTF 
WRITE (6,18) 

WRITE <6,20) ALFAF, VNFOVC, VI OVA, VCOVA ,VSQN IC» VSONCC 
WRITE <6,22) 

WRITE (6,24) TSTAT,PSTAT,PSTATC,ASTAT,RHOST,WDOT,VIC 
WRITE (6,18) 

WRITE (6,26) TTOTAL, PT , PTC , A TOTAL , RHOTOT »THETC »DEL 
WRITE (6,22) 

WRITE (6,18) 

WRITE (6, 30 XRI,YRIHUB, YR ISHR.HBTPR , ELND 
WRITE <6,18) 

WRITE <6,32) XTEST ( 1 ) , YW ING 
WRITE ( 6t 22 ) 

WRITE <6,34) NT< 1 ) ,NP ( 1 ) »NCLO, NCHI , NHUBMX,NX»KND,KSKI P»NT ( 2 ) ,NP< 2 ) 
FORMATS 


RETURN 


FORMAT < 1H0, 27X , 58HMACH 
1SSURE RATI0/107H 
2 COMP. 

FORMAT < 1 IH 
FORMAT < 1 1H 
FORMAT < 11H 
FORMAT <1H0) 

FORMAT < 87H 
1/VA V SONIC 

FORMAT ( 1H0, IIOH- 


DYNAMIC PRESSURE 
VELOCITY NO 

INC. COMP. DENSITY 

CONTROL , 1PE10.3, IP6E14.3) 

BULK , 1PE 10. 3, 1P6E14.3 ) 

FREE , 1PE10.3, IP6E14.3/8H STREAM) 


PRE 


INC. 


RATIO) 


ALFAF VINF/VC 

VS0NICC/5X,1P6E14.3) 


VINF/VA 


VC 


-//> 


< 100H 


FORMAT 
1 AST AT 
2 ) 

FORMAT 
1 ATOT 
FORMAT 
FORMAT 
IIP RATIO 
FORMAT <31H 
FORMAT <74H 
1 NX KNO 


RHOSTAT 


TSTAT 

WDOT 


PSTAT 


PSTATC 


< 101H 

RHOTOT 

<1H0,6E12.5) 

< 75H 


TTOT 


THET 


PTOT 


YRIHUB 


VIC/9X,1PE10.3,1P6E14.3 

PTOTC 

DEL/5X, 1P7E14.3) 


YRISHR 


HUB-T 


XRI 

LND/5X.1P5E14.3) 

XTEST 
NT 

KSK IP/ 1QX,1H1, I4,5X,1H1,I5, 4X, I3,5X,I3,6X,I3,6X,I2,4 
2X,I2,6X,I2/10X,1H2,I4,5X,1H2,I5) 

END 


YWING/5X, 1P2E14.3) 
NP NCLO NCHI 


NHUBMX 


) 2G 



SI8FTC AVERV DECK, DEBUG 


SUBROUTINE AVEV 
C 

C APPROACH 5 
C 

COMMON /MONOF/ 

COMMON /RDOUTi/ XON<400) ,YON( 400 ) , NSPEI 10 ) , NSPB( 10) ,XRI ,NHUBMX,NTM 
II N,NSPLT, YWI NG 

COMMON /NIN/ XOFF(200),Y0FF{ 200) ,NPMIN,NCLO,NCHI 

COMMON /R00UT2/ T< 400,2) ,VYAXI 200, 2 > « VYCRI 200) , V2 ( 400 ) ,V3 (400 ) ,VZC 
1RI200) 

COMMON /RD0UT3/ VXAX ( 200 >2 ) »VXCR( 200) 

COMMON /RD0UT4/ NTHETA,THETA ( 10) »XTEST( 10) 

COMMON /RC0NT1/ VC, V I NF, AL FAF, TTOT AL , ELND, VA, PT 
COMMON /RC0NT2/ PSTAT ,TSTAT , WDOT, NX, KND, YR IHUB, YRI SHR, UT IP 
COMMON /COUT 2/‘ V I NFP , RHOTOT , VIC 
COMMON /GETOUT/ VMAG( 3 ) , AL IL ,BLIL, CL IL 

DIMENSION IBEGIN(25), IEND(25), VBAR(400), AI400), VBAR0F(200), RH 
10BAR (400) , RBROFF ( 200 ) * RB0RT(400), RBFORT ( 200 ) 

DIMENSION I ED( 25 ) 

REWIND 2 
REWIND 3 
PI=3. 14159265 
PI0180=PI/180. 

G»32.174 

AC*P I*( YR ISHR**2-YRI HUB* *2 )/ 144. 

AT0TAL=49«*SQRT (TTOTAL) 

FACTR=( 144./G ) /RHOTOT 
NSHR=NTMI N-NHUBMX+1 
NBPl=NHUBMX+l 

C++*** 

C*** FIND THE HIGH-LIGHT ON THE SHROUD 

DO 2 I=NBP1,NTMIN 
JJ=I 

IF ( XON( I ) .LE.XONt 1+1 ) ) GO TO 4 
2 CONTINUE 

C***** 

C*** MODIFICATION FOR SPLITTER TO FIND THE LAST POINT ON THE SHROUD 

c***** 

4 DO 6 I=JJ,NTMIN 

JJS^I 

IF (XONII ).GT.X0N(I+1)) GO TO 8 
6 CONTINUE 

C*** FINO AREAS FOR POINTS ON THE SHROUD THEN INTERPOLATE FOR ALL 
C*** OTHER POINTS 

8 NHUBP1=NHUBMX+1 

IF (NSPLT.EQ.O) GO TO 12 
00 10 IN=1,NSPLT 
IEO( IN)=NSPB(IN+1)-1 
10 IF ( IN.EQ.NSPLT ) I ED ( IN ) =NTM IN 

C*** FIND AREA FOR EVERY POINT ON THE SHROUD 



c***** 

12 DO 20 I=NHUBP1,JJS 
YS=YON(I) 

XS=XON( 1 1 

IF (l.GT.JJ) GO TO 18 
ARS=0. 0 

IF ( NSPLT . EQ.O ) GO TO 16 

c***** 

C*** IF THERE ARE SPLITTERS, SUBTRACT AREA OF SPLITTERS FROM OVERALL AR 

DO 14 IN=1, NSPLT 
NS8=NSPB( IN) 

NSE=NSPE( IN) 

IF ( XS.LT. XON( NSE ).OR.XS.GT • XON ( NSB ) ) GO TO 14 
CALL SINTP (XON (NSB) , YON (NSB) »NSE-NSB+1 » XS» YSP1 ) 

CALL SINTP (XON(NSE) , YON (NSE ) , I ED{ IN )-NSE, XS»YSP2) 
ARS=PI*(YSP2**2-YSP1**2)+ARS 
14 CONTINUE 

16 CALL SINTP ( XON, YON, NHUBMX, XS, YH ) 

A ( I ) =PI*( YS**2-YH**2 ) - ARS 
GO TO 20 

18 R=SQRT( YS**2+( XS-XON ( J J ) )**2) 

All )=(1.0+(YS-Y0N( JJ ) )/(YON( JJS)-YON< J J ) ) )*PI*R*(R+XS-XON{ J J ) ) 

20 CONTINUE 

C4**** 

C*** INTERPOLATE AREAS FROM THE POINTS ON THE SHROUD TO OBTAIN 
C*** REMAINING AREAS 

NCNTH=0 

DO 24 1=1 ,NTMIN 

IF ( I.GE.NHUBP1. AND. I.LE.JJS) GO TO 24 
IF ( XON( I ) .LT.XONI JJ ) ) GO TO 22 
XA=XON(I) 

CALL SINTP ( XON ( NHUBP1 ) , A( NHUBP1 ) , J J— NHUBMX , XA , AX ) 

A ( I ) *AX 
GO TO 24 

22 NCNTH*NCNTH+1 

24 CONTINUE 

IF (NCNTH.EQ.O) GO TO 28 
00 26 1=1 ,NCNTH 
A ( I ) =A( NCNTH+1 ) 

26 CONTINUE 

28 DO 50 N*1 ,NTHETA 

THETA(N)=THETA(N) *PI0180 
COSTH=COS ( THET A( N ) ) 

CCOSTH=CL IL*COSTH 
SINTH=SIN(THETA(N) ) 

CSINTH=CLIL*SINTH 
VICT=VIC4CL1L*VMAG(3 )*COSTH 
WDOTT=G*RHOTOT*VICT*AC 
F ACTOR=FACTR*WOOTT 
WRITE (3) WOOTT ,V ICT 

C*** CALCULATE VBAR FOR EVERY POINT ON BODY 


I STOP=NTMIN 



SLOPE = <XON( JJS|-XON( JJ >>/< YON( JJS)-YON( JJ) ) 

00 32 I=1»NTMIN 

IF ( I»GT.JJ.AND. I.LE.JJS.AND.SLOPE.GT.l.O) GO TO 30 
V8AR (I )=FACT OR/A ( I ) 

GO TO 32 

30 VBAR ( I )=VINFP 

IF (VRAR( I ) . EQ .0 .0 I VBAR(II=1.0 
IF (ISTOP.EQ.NTMIN) ISTOP=I 
32 CONTINUE 

DEBUG! V8AR (I), 1=1, NT MIN) 

C 

C CNBOOY RHOBAR AND VRES CALCULATIONS 

C 

RRSRTF=RH0TOT*(1.0-.2*(VINF/AT0TAL)**2>**2.5 

RS0RTC=(l»0-«2*< VC/ATOTAL ) **2 )**2. 5 
00 38 1=1 » NTMIN 

VP=ALIL*T( I,1I+BL1L*T(I,2)+CC0STH*V2(I > 
VTH=CSINTH*V3(I) 

C 

C ORIGINAL VRESON 

C 

VRES0N=SQRT(VP**2+VTH**2) 

RESVV=VRESON 

C 

C APPROACH 5 VRESON 

c 

IF (I.GE.ISTOP.ANO.I.LE.JJS) GO TO 34 

CALL VBARIT ( VBAR( I ) » ATOTAL, RHOTOT, RHOBARC I ) ) 

GO TO 36 

34 RHQBARI I l=RRSRTF 

36 RBORTI I )=RHOBAR( I )/RHOTOT 

VRESON=VRESON*( l.O/RBORT (1)1 **( VRESON/VBARI I ) ) 

VP= VRES ON* VP/RES VV 
VTH=VRESON*VTH/RESW 
WRITE (31 VRESON, VP. VTH 
38 CONTINUE 

WRITE (2) <VBAR( I I.R80RT (I )» 1=1, NTMIN) 

C 

C OFF BOOY POINTS A ANO VBAR 

C 

J=L 

IBEGINI J)=l 

NRAKES=1 

00 42 1=1 ,NPHIN 

IF ( ABS (XOFF ( I +1 l-XOFF( I D.GT..01I GO TO 40 
GO TO 42 

40 IF (I.EQ.NPMINI GO TO 42 

J=J+l 

IBEGINI J1=I*1 
NRAKES® J 
42 CONTINUE 

00 46 1=1 .NRAKES 
I B= I BEGIN! I ) 

C***** 

C*** FIND AREA FOR OFF-BODY RAKES 

C***** 



o o o o o 


CALL SINTP (XON(NHUBPl), A< NHUBPl) , JJ-NHUBMX, XOFFI IB>,AR) 
VB=FACTOR/AR 

CALL VBAR IT ( VB, ATOT AL , RHQTOT *RHB) 

IE=I8EGIN(I+1J-1 
IF ( I.EQ.NRAKES) IE=NPMIN 
00 44 J=IB,IE 
V8AR0F( J)=VB 
RBROFF ( J ) =RHB 
44 CONTINUE 

46 CONTINUE 

00 48 1-1 *NPMIN 

ORIGINAL VRESOF 

VXC=ALIL*VXAX(I,ll+BLIL*VXAX( I , 2)+CC0STH*VXCRI I) 
VYC=ALIL*VYAX(I , 11 +BL IL*VY AX < I , 2 J +CCOSTH*VYCR< I) 
VZC=CSINTH*VZCR< II 
VRESOF=SQRT( VXC**2+VYC**2+VZC**2 I 
RESVV= VRESOF 

APPROACH 5 VRESOF 
RBFORT ( I ) -RBROFF ( I I /RHOTOT 

VRESOF=VRESOF*( 1.0/RBF0RT( I n**(VRESOF/VBAROF( I > ) 
VXC=VRESOF*VXC/RESVV 
VYC=VRESOF*VYC/RESVV 
VZC 55 VRESOF *VZC/RESVV 
WRITE €3 1 VRESOF, VXC.VYC.VZC 
48 CONTINUE 

WRITE (21 ( VBAROFt II, RBFORT ( 1 1 » I=1»NPMIN) 
THETA(N)»THETA(N)/PI0180 
50 CONTINUE 

RETURN 
END 


SIBFTC ONOFF. DECK 

SUBROUTINE ONOFF 
CALL ONBOOY 
CALL OFFBOY 
RETURN 
ENO 



fIBFTC ONBOY. DECK 

SUBROUTINE ONBODY 

C*** THIS SUBROUTINE CALCULATES ON-BODY VARIABLES 
COMMON /MONOF/ JJS»JJ 

COMMON /RDOUT1/ XONI 400) ,Y0N(400) ,NSPE(10> ,NSPB( 10) tXRI ,NHUBMX,NTM 
1IN, NSPLT, YWING 

COMMON /COUT 1/ QCA,PTC, PSPTC I . PI0180, ATOTAL ,GRHO 
COMMON /CNOUT/ VRESONI 400) , VP(400 ) , BETAONI 400) 

COMMON /RCCNT2/ PSTAT ,TSTAT, HOOT ,NX » KND, YR I HUB , YRI SHR, UT I P 
DIMENSION VTH(400), PSOPTC(400), CPC0NI400), VBAR(400>, RBORTI400) 
1, S < 400) 

CALL SRTNE ( XON, YON, XRI , YR IHUB, YRI SHR,NHUBMX,NTMIN, S > 

DO 10 I*I,NTMIN 

C*** READ FROM TAPE 3 VRESON , VP , VTH 

READ (3) VRESON (II »VP(I ) »VTHI I ) 

VCONC* • 2* ( VRESON ( I )/ ATOTAL 1**2 
IF (VCONC.GT.l.OI GO TO 2 
PSOPTC ( I ) = ( 1 .0-VCONC I **3 «5 
GO TO 4 

2 PSOPTCT 1 1*0.0 

4 IF (VTH(Il.EQ.O.O) GO TO 6 

BETAONI 1 1 =»ATAN( VTH( I I /VP ( I 1 1 /PI 0180 
GO TO 8 

6 BETAONI I )*0«0 

8 CPCON(I)=(PSOPTC(II— PSPTCI I/IQCA/PTC) 

10 CONTINUE 

READ 12) (VBARI I ) y RBORT I lit I*l» NTM IN I 

C***** 

C*** WRITE HUB COORDINATES AND VARIABLES 

WRITE (6,14) 

WRITE (6,16) 

WRITE (6,18) ( I , XON( I ) , YON ( I ), VP (I), VTH (I), VRESON( I ) , VBAR( I ) , BET AO 
IN ( I ) , S ( I ) »CPCON( I ) ,RBCRT ( I ) , PSOPTC ( I ) , 1=1 , NHUBMX ) 

C«**** 

C*** WRITE SHROUD COORDINATES AND VARIABLES 

C***»* 

WRITE (6,20) 

WRITE (6, 16) 

NHU8Pl*NHU8MX+l 

WRITE (6,18) ( I , XONI 1 ) , YON ( I ) , VP( I ) , VTH ( I ) , VRESON ( I ) , VBARI I ) , BETAO 
IN ( I ) ,S( I ) »CPCGN( I), RBORT (I ), PSOPTC ( I ), I=NHUBP1 , JJS ) 

C 

C WRITE SPLITTER COORDINATES AND VARIABLES IF IT APPLIES 
C 

IF (NSPLT .EQ.C ) GO TO 13 
DO 12 IN=1, NSPLT 



NB=NSPB( IN) 

NE=NSPB( IN+1 )-l 
IF (IN.EQ.NSPLT) NE=NTMIN 
WRITE (6,22) IN 
WRITE (6,16) 

WRITE (6,18) ( I , XON( I ) * YON ( I ) , VP ( I ) , VTH( I ) , VRESON( I ) »VBAR( I ) , BET AO 
1N( I ) ,S( I ) ,CPCON( I ) ,RBGRT ( I ) , PSOPTC ( I ) , I=NB,NE ) 

12 CONTINUE ' 

IB CONTINUE 

RETURN 

£*«*** 

C*** FORMATS 
C***»* 

c :• 

14 FORMAT (1HO, 10X, 3HHUB ) 

16 FORMAT ( 1 1 X , 14H0N— BOOY POI NT S//2X, 1H I , 6X, 1HX , 1 IX, 1HY , 1 IX, 2HVP ,9X , 6 
1HVTHET A,7X j4HVRES,7X , 5HVBARI ,7X, 4HBETA, 10X, 1HS , 11X, 3HCPC ,5X , 5HRB/R 
2Ti3X,6HPS0PTC) 

18 FORMAT ( I4,9E12.4,F7.4,F8.4) 

20 FORMAT ( 1H0, 10X,6HSHR0UD ) 

22 FORMAT ( 1H0 , 10X, 8HSPL ITT ER, I 3 ) 

END 



ilBFTC SSUB LIST, DECK 

SUBROUTINE SRTNE ( XON, YON, XR I , YRIHUB, YR ISHR, NHUBMX ,NTM I N, S ) 
DIMENSION XON(i), YON(l), SID 
C 

C S ROUTINE 

C 

ISI=0 

2 I S 1 = TSl+1 

IF (XON(ISl)-XRI ) 2,4,4 

4 S(ISI)=SQRT( (XONCISI )-XR I ) **2+( YON ( IS I l-YRIHUB )**2) 

ISl=ISI+i 

DO 6 I=IS1, NHUBMX 

SCI )*S(I-1 )+SQRT ( ( XON ( I ) —XON C I — 1 1 ) **2+( YON( I )-YON <1-1 ) ) **2 ) 

6 CONTINUE 

I S2= ISI-1 

S( IS2)=-SQRT( (XON( IS2 )-XRI )**2+< YON( I S2 )-YRIHUB ) **2 > 

IS3=ISI-2 
DO 8 1=1, IS3 
1 39= IS2-I 

S ( 1 39 ) =S ( I 39+1 )— SQRT ( ( XON( I39I-X0N II 39+ 1 ) ) **2+ ( YON (139) -YON (139+1) 
1 ) **2 ) 

8 CONTINUE 

l ST = NHUBMX 
10 ISI*ISI+1 

IF (XON(ISI)-XRI ) 12,12,10 

12 S USI) =-SQRT ( ( XON( IS I )-XRI )**2+( YON( ISI )-YRI SHR ) **2 ) 

IS1=ISI+1 

DO 14 1 = 1 SI ,NTMI N 

S(I )=S(I”l)-SQRT((XONm-XON( 1-1 ) ) **2+( YON( I )-YON ( 1-1 ) ) **2 ) 

14 CONTINUE 

IS2= ISI-1 > 

S (I S2) =SQRT ( ( XON ( IS2)— XRI) **2+( YON( I S 2 ) — YR ISHR )**2 ) 

ISMIN=NHUBMX+i 
I S3= ISI-2 
DO 16 I=ISMIN,IS3 
I39=IS2-I+NHUBMX 

S(I39)=S( 139+1 )+SQRT ( (XON( 139 )-XON ( 139+1 >) **2+ (YON ( 139 >-YON( 1 39+1 » 
1 )** 2 ) 

16 CONTINUE 

C 

C END OF S 

C 

RETURN 

END 
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IIBFTC OFBOY. DEBUG, OECK 
SUBROUTINE OFFBDY 

SUBROUTINE TO CALCULATE ALL OFF-BODY VARIABLES 
COMMON /MONOF/ JJS,JJ 

COMMON /GNOUT/ VRESONI4O0) ,VPf 400 ) , BETAONI 400 ) 

COMMON /NIN/ XOFF( 200 ) , YOFFI 200 ),NPMIN,NCLO»NCHI 
COMMON /NOUT/ I BEGIN ( 2 5 ) , I ENOI 25 ) , NOF.P < 50, 6 ) , NOS ( 25 ) , NRAKES 
COMMON /RDOUTl/ XONI 400) ,YONf 400 ) , NSPE < 10 ) , NSPB ( 10 > , XR I , NHUBMX,NTM 
II N , NSPLT , YWI NG 
COMMON /GEABC/ YI 

COMMON /C0UT1/ QCA.PTC , PSPTC I, PI0180, ATOTAL,GRHO 
COMMON /T0UT1/ SINTH,COSTH, OMEGA 

COMMON /RC0NT2/ PSTAT , TSTAT, WDOT,NX, KND, YRIHUB , YRI SHR.UTIP 
COMMON /V0UT1/ PSOPCI 100 >,PHII C 100 ) , ZETAI ( 1001 , VYI ( 100 ), CPC ( 100) ,V 
1ZI(100),VMI( 100 ) , VAFTI ( 100 ) , VS PAN I (100),ETAI(100) 

COMMON /V0UT2/ UII 100 ) ,VZPRI 1 100) , BETAP 1 1 100) , VPRII 100) , VZPRST ( 100 
l) ,BETAPS< 100),VPRST(100) ,MPRST< 100), MPRI (100) 

DIMENSION XC100), VRESIIOO), VX(IOO), BETA(IOO), PSOP(IOO), ALFA(1 
100) 

DIMENSION QLOCI300), IQSJ150), QI50), 0EVK50), QFRACT1300), YLOCI 
1300) 

DIMENSION VBRFFI 200) , RBRTFI 200 ) , Y(IOO), QST0T(50,6) 

DIMENSION VRES0FI200), VXCI200), VYC(200), VZCI200), 

1 PSOPTCI 200 ),MPRIME( 200 »,MPRIST(200) , ALFAOF ( 200 ) , 

2 BETAOFI 200 ) , VAFTI200), VSPANl 200 ) , ETAI200), 

3 ZETAI200 ) , PHK200), VMI200) .CPC0FFI200) , 

4 U( 200 ),VZPRIM(200) ,BETAPR( 200 ), VPRI ME (2 00), 

5 VZPRS ( 200 ),BETPS(200), VPRIST(200) 

REAL MPRI ME , MPRI ST ,MPRST ,MPRI 
PI = 3. 14159265 
014=1.0/1.4 
GR044=GRH0/144. 

DO 8 I=1»NPMIN 

READ FROM TAPE 3 VRESOF < I ) , VXC ( I ) , VYCII > , VZCII ) 

READ (3) VRESOFI I),VXC(I ), VYCII), VZC(I) 

VC0NA=.2*( VRESOFI I )/ATOTAL )**2 
IF IVCONA.LE.l.O) GO TO 2 
PSOPTC(I)=0.0 
MPRIMEI I )=0.0 
MPR I ST { I ) =0.0 
GO TO 4 

PSOPTCI I )*( 1.0-VC0NA)**3.5 
ALFAOFI I )=ATAN( VYCI I )/VXC(I) )/PI0180 
BETAOFI I )=ARSINi VZCI I ) /VRESOFI I ) )/PI0180 
VAFTII )-VZCI I )*SINTH+VYCI I )*COSTH 
VSPANl I )=VYCII )*SINTH-VZCI I )*COSTH 
ETA I I ) -AT AN2(VAFT(I),VXC(I))/P 10180 



ZET A ( I )=ATAN2(VSPAN( I ),VXC( I ) )/Pl0180 
PHI ( I )=ATAN2(VZC( I )* VXC( I) ) /PI 0180 
VMU »=sSQRT(VXC(I )**2+VYC(I )**2) 

CPC0FF( I |« ( PSOPTCI I) -PS PTC I ) /( QCA/PTC ) 

C 

C IF THE OFF-BODY X IS NOT AT CONTROL STATION, SKIP FOLLOWING CALCUL 

C 

IF ( XQFF( I ) .NE.XRI ) GO TO 8 
U( I )=OMEGA*YOFF< I ) 

vzpRiMm=vzcm-um 

BET APR ( I ) = AT AN2(VZPRIM( I ),VM( I ) ) 

VPRIME(I)=VH( I ) /COS{ B ETA PR ( I I) 

BET A PR ( I )=BETAPR( II/PI0I80 
VCCN=VPRIME( I )/ATOTAL 
IF (VCONA.GT.l.O) GO TO 6 
MPRIME(I)=VCON/( ( l.O-VCONA )**. 5 ) 

6 vzpRsm=-vzcm-um 

BETPS(I)=AT AN2 ( VZPRS ( I ) , VH( I ) ) 

V PR I ST ( I )=VM( I ) /COS( BETPSI I ) I 

BETPS(I)=BETPS(I)/PI0180 

VPCON=VPR IST( I )/ ATOT AL 

IF (VCONA.GT.l.O) GO TO 8 

MPRI ST ( I ) =VPCGN/ ( ( I.O-VCONA ) **• 5 ) 

8 CONTINUE 

CALL NOEPTS 

C***** 

C*** I = COUNT FOR INTERPOLATED 0FF-80DY POINTS 
C*** IK LOOP FOR NUMBER OF RAKES 

£***«* 

1=0 

DO 30 IK=1,NRAKES S 

NOS I=NOS( IK) .1 

IB=IBEGIN( IK) ; 

C*** IS = STARTING POINT TO FIND ON-BODY X VALUE 
C*** ISP = STOPPING POINT TO FIND ON-BODY X VALUE 
C*** K = COUNT FOR NUMBER OF ENDPOINTS FOR RAKE 

NS=0 

DO 28 K*1 , NOS I 

IF (K.GT.I) GO TO 10 

IS=1 

I SP=NHUBMX 
GO TO 20 

10 IF (K.EQ.NOSI) GO TO 18 

IF ( MODI K, 2 ) .EQ.O) GO TO 12 
I S=NSPE( NS ) 

ISP=NSPB(NS+1)-1 
IF (K.EQ.NOSI-1) I SP=NTM IN 
GO TO 20 
12 NS=NS+l 

14 I S=NSPB(NS ) 

ISP=NSPE!NS) 

IF ( XOFF (IB) .GT.XONI IS).OR.XOFF( IB ) .LT. XON( ISP)) GO TO 16 
GO TO 20 
16 NS=NS*1 
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GO TO 14 

18 I S=NHUBMX*1 

ISP=JJ 

c 

C DO LOOP TO SEARCH FOR ON-BODY X VALUES NEAREST TO OFF-BODY X VALUE 
C 

20 1=1*1 

X(I)=XOFF< IB ) 

I FLAG=2 

DO 26 J=IS,ISP 
IF ( MOD! K » 2 ) * EQ.O ) GO TO 22 
C 

C SEARCHING FORWARD - ‘TCP-SIDE OF A BODY 

C 

IF (Xm.LE.XONI isn GO TO 24 
IF (XON( J).LT.X( III GG TO 26 

CALL INTPOL ( 1, J, X( I > » I FLAG, VX( 1 1 » VRES Cl) » BETA ( I ) , ALFA ( I ) ) 
PS0PC(I)=(l«0-.2*(VRES(I)/AT0TAL)**2 )**3.5 
Y ! I ) =Y I 

CALL VAROFF (I , BET A, ALFA ,VX, VRES, X, Y ) 

GO TO 28 
C 

C SEARCHING BACKWARD - UNDERSIDE OF A BODY 

C 

22 IF (XON( JI.GT.X! I)» GO TO 26 

I ND= J— 1 

CALL INTPOL ( 1 , J, X ( I) , IFLAG, VX I I) , VRESI I ) » BETA 1 1 ) , ALFA (I) > 

PSOPCU ) = (l.0-.2*(VRESm/AT0TAL)**2)**3.5 

Y ( I I =Y I 

BET A=-BET A C l 1 

vxm=-vxm 

CALL VAROFF (I , BET A s ALFA, VX , VRES, X » Y ) 

GO TO 28 
24 Y(I)=0.0 

VX(I)=VXC(IB) 

VRES ( I )=VRESOF( IB) 

BETA (I )=BETAOF( IB) 

ALFAm = ALFAOF( IB) 

PSOPCI I)=PSOPTC( IB) 

GO TO 28 
26 CONTINUE 

28 CONTINUE 

30 CONTINUE 

c#**** 

C* 1 **. INTEGRATED WEIGHT FLOW BETWEEN LOWER BOUNDARY! El THER HUB OR AXIS) 
C*** AND LOCAL Y VALUE 

C**« NIO = NUMBER OF INTERPOLATED OFF BODY POINT 

NIQ=0 

IQS=0 

DO 42 J=1 ,NRAKES 
IQS= IQS+1 
QLOC ( IQS)=0.0 
NOSI=NOS( J) 

QST=0.0 

DO 40 NS=1 1 NOS 1*2 
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NI0=NI0+1 
NLOW=NOEP ( J » NS ) 

NHI=NOEP( JfNS+1 ) 

NHIMlaNHI-l 

IQS=IQS+1 

QLOC ( I QS )=P I*( PSOPTC ( NLOW) **014*1 YOFF ( NLOW ) *VXC ( NLOW) )+PSOPC (NIO) * 
1*014*(Y<NI0)*VXINI0) ) )*l YOFFtNLOW)-Y(NIO) )*QST 
DO 32 I 3 NL0W,NHIM1 
I QS 3 IQS+i 

QLOC(IQSI=QLOC( IQS-1 )+PI*< PSOPTC! 1+1 1 **014* ( YOFF ( I+l )*VXC< I>1 )) +PS 
10PTCU )**014*<Y0FF< I )*VXC( I ) >) * ( YOFF U + l >-YOFF ( I ) ) 

32 CONTINUE 

NIO=NIO+1 
l QS= IQS + t 

IF (X(NIO).LT.XON(JJ ) ) GO TO 34 

QLOC ( I OS) *QLOC f IQS-l ) +PI*( PSOPCC NI0)**014*( Y( NIO >*VX( NIO) )♦ PSOPTC ( 
1NHI ) **014* (YOFF (NHI)*VXC(NHI ) ) )* ( Y { N 10 ) -YOFF I NHI ) ) 

QST 3 QLOC( IQS) 

GO TO 36 •" 

34 QLOC! I QS)=QLOC< IQS-1) 

QST*QLOC( IQS) 

36 IF (NS.EQ.NOSI-1) GO TO 38 

IQS- IQS+1 

QLOC(IQS)=QLOC( IQS-1) 

38 QSTOT! J,NS) 3 QST 

40 CONTINUE 

IQSJ(J)=IQS-IQSAVE 
I QS A VE=IQS 

IF (J.EQ.l) IQSJI J) 3 IQS 
Q( J ) =QST 
42 CONTINUE 

DO 44 1*1, IQS 
QLOC(I) 3 QLOC(I )*GRQ44 
44 CONTINUE 

SUM=0.0 

DO 46 I 3 1,NRAKES 
Q ( 1 1 — Q (II *GR044 

IF ( I BEG I N ( I ) . NE . NCL 0 ) GO TO 46 
QBAR=Q( I ) 

46 CONTINUE 

DO 48 I=1,NRAKES 
DEV1(I) 3 <QII)-QBAR)/QBAR 
48 CONTINUE 

I ST=l 

I FN= IQSJI 1 ) 

DO 52 I 3 1 tNRAKES 
DO 50 J=I ST# IFN 
QFRACT(J)=QLOC(J)/Q( I ) 

50 CONTINUE 

1ST 3 IFN+1 
IFN 3 IFN*IGSJ(I+1) 

52 CONTINUE 

C 

C WRITE OFF-BODY DATA 

C 

REAO (2) (VBRFF! I),RBRTF(I ), I=1,NPMIN) 
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WRITE (6,82) 

NI0=0 

DO 58 1=1 tNRAKES 
NOSI =NOS( 1 ) 

DO 56 NS=l,NOSI,2 
NLOW=NOEP( I, NS) 

NHl=NOEP( I,NS+1) 

54 NIO=NI O+l 

WRITE (6,84) X(NIO),Y(NIO),VX(NIO) , VY I ( N 10 ) , VZI ( N 10 ) , VRES ( NI 0 ) , VMI 
1 ( NIO ) , VAFT I(NIO),VSPANI(NIO) ,PSOPC( NIO) 

IF (MOD(NIO,2).EQ.O) GO TO 56 

WRITE (6,86) ( J , XOFF ( J ) , YOFF ( J ) , VXC( J ) » VYC ( J ) , VZC ( J ) , VRESOF ( J ) » VM( 
1 J ) , V AFT ( J ) , VSPANI J ) , RBRTF( J ) ,PSOPTC( J ) , J=NLOW , NHI ) 

GO TO 54 
56 CGNTINUE 

58 CGNTINUE 

WRITE (6,88) 

N 10 = 0 
NQ=0 

DC 66 1=1 ,NRAKES 
NOSI =NOS( I ) 

DO 64 NS=1,N0SI ,2 
NLOW=NOEP( I, NS) 

NHI=NOEP( I.NS+l) 

60 N I 0=NI O+l 

NQ=NQ+1 

YIOC(NQ) = Y(NIO) 

WRITE (6,90) X(NIO),Y(NIO) ,CPC ( NIO-)-, ALFA( NIO ) *BETA(NIO)»ETAI(NIQI , 
1ZETAI(NI0),PHII(NI0I , QFRACT (NQ) 

IF <MOD(NIO,2).EQ.O) GO TO 64 

DO 62 J=NLOW,NHI 

NQ=NQ+1 

YLOC(NQ) = YOFF(J) 

WRITE (6,92) J , XOFF( J ) , YOFF ( J ) , VBRFF ( J ) ,CPCOFF ( J ) , ALFAOF ( J ) , BET AOF 
1(J),ETA(J),ZETA(J),PHI(J), QFRACT ( NQ ) 

62 CONTINUE 
GO TO 60 
64 CONTINUE 

66 CONTINUE 

C 

C WRITE OFF-BODY DATA AT THE CONTROL STATION 

C 

WRITE (6,94) XRI ,UTI P 
NI0=0 

DO 74 1=1 , NRAKES 
NOS I=NOS( I ) 

DO 72 NS=1 ,NOS I , 2 
NLOW=NOEP( I, NS) 

NHl=NOEP( I ,NS+i ) 

68 NI0=NI0+1 

IF (X(NIO) .NE.XRI ) GO TO 70 

WRITE (6,96) Y(NIO),UI(NIO) , VZPRI ( NIO ) » VPRI (NIO) ,MPRI(NIO) ,BETAPI( 
1NI0) , VZPRST (NIO) , VPRST ( N 10 ) , MPRST (NIO ) , BETAPSI NIO ) 

IF (M0D(NI0,2).EQ.0) GO TO 72 

WRITE (6,96) (YOFF(J) ,U( J),VZPRIM( J) , VPRI HE ( J) ,MPRIME( J) ,BETAPR( J) 
1, VZPRSI J) , VPRIST ( J) , MPR I ST ( J ) ,BETPS( J ) , J=NLOW,NHI ) 
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GO TO 68 
70 NI0=NI0+1 

72 CONTINUE 

74 CONTINUE 

C 

C WRITE WEIGHT FLOW DATA 

C 

WRITE (6,102) 

NI0=0 

DO 80 1 = 1, NRAKES 
NOSI=NOS(I) 

DO 78 J=1 t NOSI » 2 
NI0=NI0*2 

QSTOT( I»J)=QSTOT( I , J )*GR044 
QFR=QSTOT( I, J)/Q(I> 

IF CJ.GT.l) GO TO 76 

WRITE (6,98) I , X ( NIO ) , DEVI ( I ) , QSTOT( I , J ) , QFR 
GO TO 78 

76 WRITE (6,100) QSTOT ( I , J ) ,QFR 

78 CONTINUE 

80 CONTINUE 

CALL STRML ( YLOC , QFR ACT , IQS J ,NR AKES, XOFF , NOEP ) 

RETURN 

C*** FORMATS 

£**«** 

C 

82 FORMAT (1H1, 5X, 23H0FF-B00Y POINTS (RAKES)/ 

* 1H0, 10X, 11 6HC00RDI NATES * 

1 VELOCITIES * PRESS. R 

2ATI 0/123H AXIAL RADIAL AXIAL RADIAL CIRCUMF 

3RNTL RESULTANT MERIO IONAL CHORDWISE SPANWISE COMP 

4/129H IX Y VX VY VZ 

5 VRES VM VAFT VSPAN RHOBR PSOP 

6TC) 

84 FORMAT ( 5X , 1P9E12. 4, 7X ,OPF 8. 4 ) 

86 FORMAT (1 5 , 1P9E12. 4, 0PF7 .4 , 0PF8 . 4 ) 

88 FORMAT (//1H0.112H COORDINATES NEW CP 


1 * ANGLES */l 

209H AXIAL RADIAL MERIDIONA 

3L FLOW UNOERTURNG SPANWISE SWIRL/122H I X 

4 Y VBR I CPC ALPHA BETA 

5ETA ZETA PHI QFRACT ) 

90 FORMAT ( 5X, 1P2E12.4, 12X, 1P7E12 . 4) 

92 FORMAT ( 1 5 , 1P10E 12.4 ) 

94 FORMAT ( 1HL 5X.25HRELATIVE ROTOR INLET DATA/ 

* 1H0, 14H X = , F 10. 4, 17H UTIP = .F10.4//12 

12H Y U VZPRIME VPRIM MPRIME 

2 BETAPR VZPRST VPRST MPRS BETAPS) 

96 FORMAT { 5X , 1 P10E 12 .4 ) 

98 FORMAT ( I 8,2X, 1PE11 . 4 , 5X , 1PE 11 . 4,6X , IPE 1 1.4, 2X , 1PE 1 1 .4 ) 

100 FORMAT (43X,IPE11.4, 2X, 1PEH.4) 

102 FORMAT ( 1HL , 5X, 21HRAKE WEIGHT FLOW DATA/ 

* 1H0, 63H I X (Q( I )-QBAR ) /QBAR QS TOT 

1 QFR) 

END 
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SIBFTC NOEPT . DEBUG, DECK 
SUBROUTINE NOEPTS 

C*** THIS SUBROUTINE IS TO FIND THE END POINTS - FOR RAKES NEAR HUB, 
C*** SHROUD AND/OR SPLITTERS 

C*** NOS = THE NUMBER OF END POINTS FOR EACH RAKE = 2*NO. OF SPLITTE 

C*** *2 (HUB AND SHROUD) 

C*** NOEP = THE INDEX OF THE RAKE ENDPOINTS 

C***** 

COMMON /NIN/ XOFF(20‘3),Y0FF( 200 ) , NPM IN, NCLO, NCHI 
COMMON /NOUT/ IBEG IN ( 25 ) , I EN0( 25 ) , NOEP< 50, 6) ,NOS ( 25 ) ,NRAKES 
COMMON /RDOUT 1/ XON( 400 ) ,Y0N(400 ) , NSPE ( 10 ) , NSPB ( 10 ) ,XRI , NHUBMX ,NTM 
1IN.NSPLT, YWING 
J=1 

I BEGIN! I ) = 1 
NPMNM1=NPM IN-1 
DO 4 I=1,NPMNM1 

IF (ABS(X0FF(I+1)— XOFF(I ) ) . GT. .0 I ) GO TO 2 
GO TO 4 

2 I END ( J ) = I 

J=J+1 

I BEG IN( J ) = 1 + 1 
4 CONTINUE 

NRAKFS= J 

IEND( J)=NPMIN ' 

C*** FIND THE END POINTS OF THE SPLITTER 

C**4** 

00 10 1=1 , NR AKES 
I B= I BEGIN ( I ) 

I E= I END( I ) 

I EM1=IE-1 

DYTEST=ABS ( YOFFI IB )- YOFF ( I B+l ) ) 

C***** 

C*** NS IS THE COUNTER TO DETERMINE NUMBER OF END POINTS PER RAKE 
C*** NOEP IS THE END POINT INDEX. 

NS = 1 

N0EP(I,1)*IB 
IF (NSPLT.EQ.O) GO TO 8 
00 6 K= I B , I EMI 

IF (ABS<ABS(YOFF(K*l)-Y0FF.(K>)-DYTEST).LE.1.0E-4) GO TO 6 

NS=NS+1 

NOEP ( I ,NS )=K 

NS=NS+1 

NUE P ( I ,NS ) =K + 1 

0YTEST=ABS(Y0FF(K+l)-Y0FF(K+2) ) 

6 CONTINUE 

8 NS=NS+i 

NOEP ( I »NS ) = I E 
. NCS ( 1 )=NS 
10 CONTINUE 

RETURN 
END 



<NJ -* U o o 


SIBFTC VAROF. DEBUG t DECK 

SUBROUTINE VAROFF ( I , BET A, ALFA.VX, VRES, X, Y ) 

DIMENSION BETA(l), ALFA(l), VXfl), VRESU). XII), YU) 

COMMON /T OUT 1/ S INTH , COSTH, OMEGA 

COMMON /NIN/ XOFF(200)»YOFF(200),NPMIN,NCLO,NCHI 

COMMON /COUT 1/ QCA ,PTC , PSPTC I , P 10180 , ATOTAL, GRHO 

COMMON / VOUT 1/ PSOPC ( 100 ) , PH II ( 100 ) , ZETAI ( 100 ) , VY 1 1 100 ) ,CPC < 100 ) ,V 
1ZIUOO)»VNI< 100 ) » VAFT 1 1 100 ) , VSPANI ( 100),ETAI (ICO) 

COMMON /V0UT2/ U1 ( 100 ) , VZPR I 1 100 ) , BETAP I ( 100 > , VPRI 1 100 ) , VZPRST ( 100 
1 > tBETAPSI 100 > , VPRST ( 100 ) ,MPRST I 100 ) ,MPRI ( 100 ) 

REAL MPRST,MPRI 
VCAN~.2*IVRES< I ) /ATOTAL )**2 
IF ( VC AN. L E . 1.0) GO TO 2 
PSOPC ( I )=0 .0 
MPR I ( I ) =0 . 0 
MPRST ( I )=0.0 
GO TO 

PSOPC! U = U.O-VCAN)**3.5 
VY I ( I )=VX< I)*TAN(ALFA< I ) *PI0180) 

cpcm = (psopcm-pspTcn / iqca/ptc > 

VZI ( I)=VRES< I )*SIN(BETA< I)*PI0180) 

VM 1 1 1) =SQRT ( VX III **2 +VY I ( l )**2 ) 

VAFTIU)=VZI (D^SINTH+VYK I )*COSTH 
VSPANI ( I )*VYI ( I I*S1NTH-VZI ( I l*COSTH 
ETAI(I)=ATAN2(VAFTim,VXf IH/PI0180 
ZETA I (I) = ATAN2( VSPANI! I l,VX( IU/PI0180 
PHIim=ATAN2(VZim,VX( IU/PI0180 

IF X IS NOT AT THE CONTROL STATION SKIP FOLLOWING CALCULATIONS 

IF (XII). NE. XOFF ( NCLO ) ) RETURN 
UI< I >=OMEGA*Y< I ) 

VZPRim = VZI(I)-UKI ) 

BET API! I )= AT AN2 1 VZPR I(I),VMI(I)) 

VPRII I )=VMl ( I )/COS( BETAP III)) 

BETAPI (I)*BETAPI( D/PI0180 
IF I VC AN. GT. 1.0) GO TO 6 
VCON=VPRI ( I) /ATOTAL 
MPR 1 1 1 )=VCGN/ ( ( l .O-VCAN ) **. 5 ) 

6 VZPRST(I)=-VZI(I )-UI (I) 

BETAPS(I)=AT AN2 1 VZPRST ( I ),VMK I) > 

VPRSTI I )=VMI ( I J/COSI BETAPSI I ) ) 

BETAPSI I )=8ETAPS( I )/ PI 01 80 
IF IVCAN.GT.l.O) RETURN 
VPCON=VPRST (I) /ATOTAL 
MPRSTI I )=VPCON/l (1«0-VCAN)**.5) 

RETURN 

END 



a) o o ^ n> noo 


$IBFTC STS ML. DEBUG 

SUBROUTINE STRML ( Y, Q , IQ,NRAKES,X, N ) 

DIMENSION Yd), Q(l), IQ(1), XU), N(l,l) 

THIS SUBROUTINE CALCULATES STREAMLINES 

WRITE 16,6) 

DELQ=.02 
I ST= 1 
I FN= IQ( 1 ) 

DO 4 1-1, NRAKES 
NQ=N( I ,1 ) 

QSTRM=DELQ 
WRITE (6,8) X ( NQ ) 

CALL SINTP (Q( IST),Y( 1ST), IFN-IST+1, QSTRM, YSTRM) 
WRITE (6,10) QSTRM, YSTRM 
QSTRM=QSTRM+DELQ 
IF (QSTRM. LE. 1.0) GO TO 2 
I ST = IFN+1 
IFN=IFN+IQ( 1*1) 

CONTINUE 
RETURN 

FORMAT ( 1H0.10X, 11HSTREAML INES/ ) 

FORMAT ( 1HO , 10X, 4HX * , F7. 3/ 10X, 5HQSTRM, 10X, 5HYSTRM ) 
10 FORMAT (5X,1PE12.5,6X,1PE12.5) 

' END 



LISTING OF INPUT CARDS FOR TEST CASE 



SCIRCL INPUT 


TEST CASE 




TEST I 











, , : 

2.0 

.25 

1.0 


6.0 








3 












- 2;0 1 " 

2.5 

5.0 

6 









4.0 

2.75 

4.75 

9 





i 




6.0 

2.75 

4.75 

9 








* " * 

1.0 

5.0 










, ; •• 

1.0 

0.0 

0.0 

0.0 

.50 








2.5 

0.0 

0.0 

0.0 

.50 

.25 

1.5 

2.0 

.2.0 

3.5 



1.0 

2.0 

2.0 

3.5 

- 2.25 






- 


0.0 

2.0 

2.0 

3.5 

2.25 

4.5 

2.39 

6.0 

2.5 

12. 



1.0 

6.0 

2.5 

12. 

2.5 








2.0 

5.0 











1.0 

12. 

5.0 

6.0 

5.0 








1.0 

6.0 

5.0 

5.0 

5.0 






*. 


-3.0 ' 

6.0 

5.0 ; 

5.0 

5.0 

2.0 

5.5 

0.0 

5.5 




, -.1.0 

4.Q 

5.5 

2.0 

5.5 

0.0 

6.65 

1.699 

30. 




1.0 

0.0 

6.65 

0.0 

20.'- 







EOD INPUT 


THESE CARDS ARE ALL PUNCHED BY PROGRAM SCIRCL 




TEST CASE 




3-BODY 

TEST 

l 

3 1110 






TEST 

l 







TEST 

1 

41 






TEST 

1 

1 

0 





TEST 

l 

0 . 

0 . 

-0. 

0.016758 

0.075506 

0.177876 



0.316638 

0.483249 

0.664451 

0.863316 

1.075317 

1.297026 



1.525978 

1.760536 

2.000000 

2.250000 

2.500000 

2.750000 



3.000000 

3.250000 

3.500000 

3.749816 

3.998633 

4.248171. 



4.498234 

4.748669 

4.999341 

5.250110 

5.500776 

5.750977 



6.000000 

6.254089 

6.558996 

6.924684 

7.363950 

7.890829 



8.523084 

9.281790 

10.192237 

11.096118 

12.000000 




0 . 

0.250000 

0.500000 

0.750708 

0.961274 

1.151866 



1.319440 

1.464105 

1.583985 

1.687325 

1.774846 

1.847875 



1.908128 

1.957771 

2.000000 

2.041667 

2.083333 

2.125000 



2.166667 

2.208333 

2.250000 

2.289805 

2.326024 

2.359299 



2.389795 

2.417534 

2.442390 

2.464049 

2.481898 

2.494743 



2.500000 

2.500000 

2 .500000 

2.500000 

2.500000 

2.500000 



2.500000 

2.500000 

2.5COOOO 

2.500000 

2.500000 




60 






TEST 

1 

2 

0 





TEST 

i 

12.000000 

11.096118 

10.192237 

9.281790 

8.523084 

7.890829 

, * 


7.363950 

6.924884 

6.558996 

6.254089 

6.000000 

5.750000 



5.500000 

5.250000 

5.000000 

4.758758 

4.505645 

4.240505 



3.963951 

3.677557 

3.383893 

3.089105 

2.801122 

2.522935 



2.256492 

2.000000 

1.773871 

1.572897 

1.379335 

1.194856 



1.018986 

0.851496 

0.694532 

0.547348 

0.414819 

0.296525 



0.194941 

0.112475 

0.051336 

0.013387 

0 . 

0 . 



0 . 

0 . 

0 . 

0 . 

0 . 

0 . 



0 . 

0 . 

0 . 

0 . 

0 . 

0 . 



0 . 

0 . 

0 . 

0 . 

0 . 

0 . 



5.000000 

5.000000 

5.000000 

5.000000 

5.000000 

5.000000 



5.000000 

5.000000 

5.000000 

5.000000 

5.000000 

5.000000 



5.000000 

5.000000 

5.000000 

5.009160 

5.036257 

5.079913 



5.137711 

5.205818 

5.278969 

5.350155 

5.412077 

5.459720 



5.489660 

5.500000 

5.500939 

5.506328 

5.519450 

5.542613 



5.577614 

5.625974 

5.680220 

5.765821 

5.857039 

5.962749 



6.081901 

6.212809 

6.353156 

6.500028 

6.650000 

6.832585 



7.051688 

7.314611 

7.630119 

8.008728 

8.463059 

9.008256 



9.662493 

10.447577 

11.389678 

12.346381 

13.303083 

14.259785 



15.216488 

16.173190 

17.129892 

18.086594 

19.043297 

20.000000 



4 






TEST 

1 

....... . 3 

0 





. TEST. 

1 

12.000000 

12.000000 

12.000000 

12.000000 





2.500000 

3.333333 

4.166667 

5.000000 





24 






TEST 

1 

0 

0 





TEST 

L 

2.000000 

2.000000 

2.000000 

2.000000 

2.000000 

2.000000 



4.000000 

4.000000 

4 .OCOOOC 

4.000000 

4.000000 

4.000000 



4.000000 

4.000000 

4.000000 

6.000000 

6.000000 

6.000000 



6.000000 

6.000000 

6 ,000000 

6.000000 

6.000000 

6.000000 



2.500000 

3 .000000 

3.500000 

4.000000 

4. 500000 

5.000000 



2.750000 

3.000000 

3.250000 

3.50000C 

3.750000 

4.000000 



4.250000 

4.500000 

4.750000 

2.750000 

3.000000 

3.250000 



3.500000 

3.750000 

4 .OCOOOC 

4.250000 

4.500000 

4.750000 






2*25 

2.5 



TEST 

CASE 

2-BODY TEST 

1 10 


TEST 1 



TEST 1 

41 


TEST 1 

1 

1 

TEST 1 

60 


TEST 1 

2 

1 

TEST 1 

24 


TEST 1 

0 

0 

TEST 1 


2.000000 

2.000000 

2.000000 

2.000000 

2.000000 

2.00000U 

4.000000 

4.000000 

4.000000 

4.000000 

4.000000 

4.000000 

4.000000 

4.00CC00 

4.000000 

6.000000 

6.000000 

6 . OOGCGC 

6.000000 

6.000000 

6 .000000 

6.000000 

6 . 000000 

6.000000 

2.500000 

3.000000 

3.500000 

4.000000 

4.500000 

5.000000 

2.750000 

3.000000 

3.250000 

3.500000 

3.750000 

4.000000 

4.250000 

4.500000 

4.75000C 

2.750000 

3.000000 

3.2500UU 

3.500000 

3.750000 

4.000000 

4.250000 

4.500000 

4.750000 


COMBYN INPUT 


TEST - 1 


102 

24 90 24 1 


7C0. 

0.0 0.0 0.0 

0.0 

0.0 

0.0 0.0 


1 

16 24 


0.0 



6.0 

2.5 5.0 

40 


HERE INSERT BINARY RECORD CARDS PUNCHED BY PROGRAM EOD 


TEST-1 


102 

24 99 24 1 l 


700. 

100. 0.0 0.0 

o 

. 

o 

0.0 

0.0 0.0 


3 

16 24 


0.0 

90. 180. 


0.0 



6.0 

2.5 5 . C 

40 
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UJ 
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UJ UJ 


LU 

UJ 
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X 
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O 

o 
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UJ 
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© 
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O 
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— 
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LJ 
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< 

UJ 
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to 
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to 
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< 
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O 

o 

pn 
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-J 
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— j 
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a 
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cc 

« 

• 

© ll 
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• 
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UJ 

*- CM CM 
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< © 

UJ 

►“ «0 CM 
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>— 
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sO 

in 

r- 
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UJ 

o 
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o 
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O cn 

u cn 
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O UJ 
UJ wj 
UJ UJ 
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UJ © 
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147 


INPUT FOR THE COMBINE. PRCGRAP NT ( 1 )= . 102 NT ( 2 ) = 99 NHUBMX= 4C NP= .24 




O O C* 

o 

O o 

o o G o 
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o 
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o 
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O 

o © o 

O o 
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o 
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o 
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© 
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o 
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c 
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o 
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c 
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4 
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4 

4 

4 
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4 

4 

4 
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a: 

tu 
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UJ 
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in 
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4> 

m 
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IT 
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CO 
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CO 
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Figure 2. - Idealized profile of VTOL inlet. 
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Figure 3« Idealized profile of conventional inlet 
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Figure 4. - Basic solutions, V^. 


AT ANY POINT, V = AVj + B V 2 + CV 3 

A, B, AND C ARE DETERMINED BY 
SPECIFYING VALUES OF: 


V c AVERAGE AXIAL VELOCITY 

AT CONTROL STATION 

Voo MAGNITUDE OF FREE STREAM 
VELOCITY 

a DIRECTION OF FREE STREAM 

VELOCITY RELATIVE TO 
THE INLET AXIS 


XT Voo 



Figure 5. - Combined solution, V. 
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